hoggl 0.2.0.0 → 0.2.0.1

raw patch · 4 files changed

+41/−63 lines, 4 filesdep ~http-clientnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: http-client

API changes (from Hackage documentation)

Files

• hoggl.cabal +3/−2
• main/Main.hs +25/−51
• src/Network/Hoggl.hs +8/−8
• src/Network/Hoggl/Types.hs +5/−2

@@ -3,7 +3,7 @@ description:         Toggl is a simple tool for time tracking. This package provides a library                      for accessing the Toggl API from Haskell, and an example executable that uses                      the library.-version:             0.2.0.0+version:             0.2.0.1 license:             BSD3 license-file:        LICENSE author:              Markus Hauck@@ -27,7 +27,7 @@                      , either                      , formatting                      , hashable-                     , http-client < 0.6+                     , http-client                      , http-client-tls                      , mtl                      , servant >= 0.9@@ -45,6 +45,7 @@   hs-source-dirs:      main   build-depends:       base >= 4 && < 5                      , either+                     , formatting                      , hoggl                      , http-client                      , http-client-tls

@@ -1,3 +1,4 @@+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} module Main where @@ -11,8 +12,11 @@ import qualified Data.Text.IO as T import           Data.Time.Calendar (Day, fromGregorian, toGregorian) import           Data.Time.Calendar.WeekDate (toWeekDate, fromWeekDate)-import           Data.Time.Clock (UTCTime(..), getCurrentTime, addUTCTime)+import           Data.Time.Clock (UTCTime(..), getCurrentTime) import           Data.Time.Format (formatTime, defaultTimeLocale, parseTimeM)+import           Formatting (sformat, (%))+import qualified Formatting as F+import qualified Formatting.Time as F import           GHC.IO.Handle.FD (stderr) import           Network.HTTP.Client (newManager) import           Network.HTTP.Client.TLS (tlsManagerSettings)@@ -33,9 +37,9 @@                   <> header "hoggl - the Haskell Toggl client.")  run :: HoggleArgs -> IO ()-run (HoggleArgs auth _ _ TimeToday) = do+run (HoggleArgs auth _ TimeToday) = do   manager <- newManager tlsManagerSettings-  let clientEnv = ClientEnv manager togglBaseUrl+  let clientEnv = mkClientEnv manager togglBaseUrl   e <- runClientM (timeEntriesToday auth) clientEnv   case e of     Left _ -> die "There was an error."@@ -43,31 +47,31 @@       ds <- traverse calcDuration ts       T.putStrLn (pretty (sum ds)) -run (HoggleArgs auth _ _ TimeWeek) = do+run (HoggleArgs auth _ TimeWeek) = do   day <- utctDay <$> getCurrentTime   let (year,weekNr,dow) = toWeekDate day   doReport auth (fromWeekDate year weekNr 1) (fromWeekDate year weekNr dow) -run (HoggleArgs auth _ _ TimeMonth) = do+run (HoggleArgs auth _ TimeMonth) = do   day <- utctDay <$> getCurrentTime   let (year,month,dom) = toGregorian day   doReport auth (fromGregorian year month 1) (fromGregorian year month dom) -run (HoggleArgs auth _ _ StartTimer) = do+run (HoggleArgs auth _ StartTimer) = do   e <- tryStartDefault auth   case e of     Left _ -> die "Failed to start timer."     Right _ -> return () -run (HoggleArgs auth _ _ StopTimer) = do+run (HoggleArgs auth _ StopTimer) = do   e <- tryStopRunning auth   case e of     Left _ -> die "Failed to stop timer."     Right _ -> return () -run (HoggleArgs auth _ _ Info) = do+run (HoggleArgs auth _ Info) = do   manager <- newManager tlsManagerSettings-  let clientEnv = ClientEnv manager togglBaseUrl+  let clientEnv = mkClientEnv manager togglBaseUrl   e <- runClientM (listWorkspaces auth) clientEnv   case e of     Left _ -> die "Failed to get workspaces."@@ -75,22 +79,19 @@       putStrLn "Workspaces:"       for_ ws (putStrLn . ("- " <>) . workspacePretty) -run (HoggleArgs auth lastDow workHours HowLong) = do+run (HoggleArgs auth workHours HowLong) = do   manager <- newManager tlsManagerSettings-  let clientEnv = ClientEnv manager togglBaseUrl-  start <- startOfCurrentWeek+  let clientEnv = mkClientEnv manager togglBaseUrl+  start <- utctDay <$> getCurrentTime   eCurLogged <- runClientM (timeEntriesFromTillNow auth start) clientEnv   case eCurLogged of     Left _ -> die "Failed to get time entries."     Right ts -> do       worked <- sum <$> traverse calcDuration ts-      req <- requiredTime lastDow workHours-      let diff = fromIntegral req - worked-      endTime <- addUTCTime diff <$> getCurrentTime-      let fendTime = formatTime defaultTimeLocale "%R" endTime-      T.putStrLn $ pretty diff <> T.pack (", average reached at " <> fendTime)+      let diff = (fromIntegral workHours * 60 * 60) - worked+      T.putStrLn (sformat ("Target of " % F.int % " hours reached: " % F.diff True) workHours diff) -run (HoggleArgs auth _ _ (Report rSince rUntil)) = do+run (HoggleArgs auth _ (Report rSince rUntil)) = do   tSince <- parseTimeM True defaultTimeLocale dateFormat rSince   tUntil <- case rUntil of     Just rUntil' -> parseTimeM True defaultTimeLocale dateFormat rUntil'@@ -100,7 +101,7 @@ doReport :: Token -> Day -> Day -> IO () doReport auth tSince tUntil = do   manager <- newManager tlsManagerSettings-  let clientEnv = ClientEnv manager togglBaseUrl+  let clientEnv = mkClientEnv manager togglBaseUrl   eResult <- runClientM (do     ws <- listWorkspaces auth     when (length ws /= 1) (liftIO $ die "Ambiguous workspace")@@ -119,10 +120,10 @@         T.putStrLn (T.pack (formatTime defaultTimeLocale dateFormat (unpack (teStart (head tesPerDay))))                  <> ": "                  <> pretty (sum durations))-      T.putStrLn ("Total: " <> pretty (fromIntegral (drTotalGrand report)))+      T.putStrLn ("Total: " <> pretty @Double (fromIntegral (drTotalGrand report)))   where unpack (ISO6801 x) = x -data HoggleArgs = HoggleArgs Token Integer Integer HoggleCmd+data HoggleArgs = HoggleArgs Token Integer HoggleCmd data HoggleCmd = TimeToday                | TimeWeek                | TimeMonth@@ -137,19 +138,11 @@ token :: Parser Token token = Api <$> strOption (long "token" <> help "API Token") -lastDowOpt :: Parser Integer-lastDowOpt = option auto (long "last-dow"-                       <> short 'l'-                       <> value 5-                       <> showDefault-                       <> help "Last work day of week (1 = Monday)")- workHoursOpt :: Parser Integer-workHoursOpt = option auto (long "work-yours"-                         <> short 'h'+workHoursOpt = option auto (long "hours"                          <> value 8                          <> showDefault-                         <> help "Number of hours to work per day in avg.")+                         <> help "Number of hours to work per day.")  todayCmd :: Mod CommandFields HoggleCmd todayCmd = command "today" (info (pure TimeToday) (progDesc "List today's time."))@@ -167,7 +160,7 @@ stopTimerCmd = command "stop" (info (pure StopTimer) (progDesc "Stop the current timer."))  howLongCmd :: Mod CommandFields HoggleCmd-howLongCmd = command "howlong" (info (pure HowLong) (progDesc "How long until 8h per day reached."))+howLongCmd = command "howlong" (info (pure HowLong) (progDesc "How long until 8h reached."))  reportCmd :: Mod CommandFields HoggleCmd reportCmd = command "report" (info (Report <$> strArgument (metavar "SINCE")@@ -180,7 +173,6 @@ hoggleArgsParser :: Parser HoggleArgs hoggleArgsParser = HoggleArgs                <$> token-               <*> lastDowOpt                <*> workHoursOpt                <*> subparser (todayCmd                            <> weekCmd@@ -191,26 +183,8 @@                            <> reportCmd                            <> infoCmd) -startOfCurrentWeek :: IO Day-startOfCurrentWeek = do-  today <- utctDay <$> getCurrentTime-  let (year,weekNr,_) = toWeekDate today-      monday = fromWeekDate year weekNr 1-  return monday- die :: String -> IO () die msg = hPutStrLn stderr msg >> exitFailure--requiredTime :: Integer -> Integer -> IO Integer-requiredTime lastDow hoursPerDay = dowToSecondsNeeded-                                 . min lastDow-                                 . fromIntegral-                                 . thrd-                                 . toWeekDate-                                 . utctDay-                               <$> getCurrentTime-  where thrd (_,_,x) = x-        dowToSecondsNeeded dow = dow * hoursPerDay * 60 * 60  dateFormat :: String dateFormat = "%Y-%m-%d"

@@ -55,8 +55,8 @@ currentTimeEntry :: Token -> ClientM (Maybe TimeEntry) currentTimeEntry token = (Just <$> currentTimeEntry' (Just token)) `catchError` handler   where-    handler :: ServantError -> ClientM (Maybe TimeEntry)-    handler DecodeFailure {responseBody = "{\"data\":null}"} = return Nothing+    handler :: ClientError -> ClientM (Maybe TimeEntry)+    handler (DecodeFailure "{\"data\":null}" _) = return Nothing     handler e = throwError e  stopTimer :: Token -> TimeEntryId -> ClientM TimeEntry@@ -127,16 +127,16 @@  prettyCurrent :: Token -> IO () prettyCurrent authorization = do-  manager <- newManager tlsManagerSettings-  etimer <- runClientM (currentTimeEntry authorization) $ ClientEnv manager togglBaseUrl+  nmanager <- newManager tlsManagerSettings+  etimer <- runClientM (currentTimeEntry authorization) $ mkClientEnv nmanager togglBaseUrl   case etimer of     Right (Just timer) -> calcDuration timer >>= T.putStrLn . pretty     _ -> return ()  tryStartDefault :: Token -> IO (Either HogglError TimeEntry) tryStartDefault authorization = do-  manager <- newManager tlsManagerSettings-  let clientEnv = ClientEnv manager togglBaseUrl+  nmanager <- newManager tlsManagerSettings+  let clientEnv = mkClientEnv nmanager togglBaseUrl   currentTimer <- runClientM (currentTimeEntry authorization) clientEnv   case currentTimer of     Right Nothing ->@@ -146,8 +146,8 @@  tryStopRunning :: Token -> IO (Either HogglError TimeEntry) tryStopRunning authorization = do-  manager <- newManager tlsManagerSettings-  let clientEnv = ClientEnv manager togglBaseUrl+  nmanager <- newManager tlsManagerSettings+  let clientEnv = mkClientEnv nmanager togglBaseUrl   currentTimer <- runClientM (currentTimeEntry authorization) clientEnv   case currentTimer of     Right (Just TimeEntry {teId = tid}) ->

@@ -23,6 +23,7 @@ import           Codec.Binary.Base64.String (encode) import           Control.Applicative ((<|>)) import           Control.Monad (mzero)+import           Control.Monad.Fail import           Data.Aeson (FromJSON(..), Value (..), (.:), (.:?), ToJSON(..), object, (.=), (.!=)) import           Data.Aeson.Types (Parser) import qualified Data.HashMap.Strict as H@@ -58,7 +59,7 @@   parseJSON (String s) = ISO6801 <$> parseTimeStamp s   parseJSON _ = mzero -parseTimeStamp :: Monad m => Text -> m UTCTime+parseTimeStamp :: (MonadFail m, Monad m) => Text -> m UTCTime parseTimeStamp ts =   parseTimeM True              defaultTimeLocale@@ -80,7 +81,7 @@    toUrlPiece (Api token) = toUrlPiece $ "Basic " ++ encode (token ++ ":api_token")    toUrlPiece (UserPass user pass) = toUrlPiece $ "Basic " ++ encode (user ++ ":" ++ pass) -data HogglError = ServantError ServantError | HogglError String deriving Show+data HogglError = ServantError ClientError | HogglError String deriving Show  data TimeEntryStart = TES { tesDescription :: Maybe Text                           , tesTags :: [Text]@@ -102,6 +103,7 @@                            ,teStop :: Maybe ISO6801                            ,teDuration :: NominalDiffTime                            ,teDescription :: Maybe Text+                           ,teTags :: Maybe [Text]                            }deriving (Show,Eq)  instance FromJSON TimeEntry where@@ -114,6 +116,7 @@                                    <*> (d .: "stop" <|> d.:?? "end")                                    <*> (convert <$> ((d .: "duration") <|> ((`div` 1000) <$> (d .: "dur"))))                                    <*> d .:? "description"+                                   <*> d .:? "tags"           p _ = mzero           convert :: Integer -> NominalDiffTime           convert = fromIntegral