diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Markus Hauck + +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 Markus Hauck 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hoggl.cabal b/hoggl.cabal new file mode 100644 --- /dev/null +++ b/hoggl.cabal @@ -0,0 +1,56 @@ +name: hoggl +synopsis: Bindings to the Toggl.com REST API +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 +license: BSD3 +license-file: LICENSE +author: Markus Hauck +maintainer: markus1189@gmail.com +category: Network +build-type: Simple +cabal-version: >=1.10 + +library + ghc-options: -Wall + exposed-modules: Network.Hoggl + , Network.Hoggl.Types + , Network.Hoggl.Pretty + other-extensions: DataKinds + , GeneralizedNewtypeDeriving + , OverloadedStrings + , TypeOperators + build-depends: aeson + , base >=4.9 && < 5 + , base64-string + , either + , formatting + , hashable + , http-client < 0.6 + , http-client-tls + , mtl + , servant >= 0.9 + , servant-client >= 0.9 + , text + , time + , transformers + , unordered-containers + + hs-source-dirs: src + default-language: Haskell2010 + +executable hoggl + main-is: Main.hs + hs-source-dirs: main + build-depends: base >= 4 && < 5 + , either + , hoggl + , http-client + , http-client-tls + , optparse-applicative + , servant-client + , text + , time + , transformers + default-language: Haskell2010 diff --git a/main/Main.hs b/main/Main.hs new file mode 100644 --- /dev/null +++ b/main/Main.hs @@ -0,0 +1,216 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) +import Data.Foldable (for_) +import Data.Function (on) +import Data.List (groupBy,sortOn) +import Data.Monoid ((<>)) +import qualified Data.Text as T +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.Format (formatTime, defaultTimeLocale, parseTimeM) +import GHC.IO.Handle.FD (stderr) +import Network.HTTP.Client (newManager) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Options.Applicative +import Servant.Client +import System.Exit (exitFailure, exitFailure) +import System.IO (hPutStrLn) + +import Network.Hoggl +import Network.Hoggl.Types +import Network.Hoggl.Pretty + +main :: IO () +main = execParser opts >>= run + where opts = info (helper <*> hoggleArgsParser) + (fullDesc + <> progDesc "Haskell client for Toggl." + <> header "hoggl - the Haskell Toggl client.") + +run :: HoggleArgs -> IO () +run (HoggleArgs auth _ _ TimeToday) = do + manager <- newManager tlsManagerSettings + let clientEnv = ClientEnv manager togglBaseUrl + e <- runClientM (timeEntriesToday auth) clientEnv + case e of + Left _ -> die "There was an error." + Right ts -> do + ds <- traverse calcDuration ts + T.putStrLn (pretty (sum ds)) + +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 + day <- utctDay <$> getCurrentTime + let (year,month,dom) = toGregorian day + doReport auth (fromGregorian year month 1) (fromGregorian year month dom) + +run (HoggleArgs auth _ _ StartTimer) = do + e <- tryStartDefault auth + case e of + Left _ -> die "Failed to start timer." + Right _ -> return () + +run (HoggleArgs auth _ _ StopTimer) = do + e <- tryStopRunning auth + case e of + Left _ -> die "Failed to stop timer." + Right _ -> return () + +run (HoggleArgs auth _ _ Info) = do + manager <- newManager tlsManagerSettings + let clientEnv = ClientEnv manager togglBaseUrl + e <- runClientM (listWorkspaces auth) clientEnv + case e of + Left _ -> die "Failed to get workspaces." + Right ws -> do + putStrLn "Workspaces:" + for_ ws (putStrLn . ("- " <>) . workspacePretty) + +run (HoggleArgs auth lastDow workHours HowLong) = do + manager <- newManager tlsManagerSettings + let clientEnv = ClientEnv manager togglBaseUrl + start <- startOfCurrentWeek + 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) + +run (HoggleArgs auth _ _ (Report rSince rUntil)) = do + tSince <- parseTimeM True defaultTimeLocale dateFormat rSince + tUntil <- case rUntil of + Just rUntil' -> parseTimeM True defaultTimeLocale dateFormat rUntil' + Nothing -> utctDay <$> getCurrentTime + doReport auth tSince tUntil + +doReport :: Token -> Day -> Day -> IO () +doReport auth tSince tUntil = do + manager <- newManager tlsManagerSettings + let clientEnv = ClientEnv manager togglBaseUrl + eResult <- runClientM (do + ws <- listWorkspaces auth + when (length ws /= 1) (liftIO $ die "Ambiguous workspace") + detailedReport auth + (wsId (head ws)) + (ISO6801Date tSince) + (ISO6801Date tUntil) + "hoggl") clientEnv + case eResult of + Left e -> do + print e + die "Failed to get report." + Right report -> do + for_ (groupBy ((==) `on` (utctDay . unpack . teStart)) . sortOn teStart . drData $ report) $ \tesPerDay -> do + durations <- traverse calcDuration tesPerDay + T.putStrLn (T.pack (formatTime defaultTimeLocale dateFormat (unpack (teStart (head tesPerDay)))) + <> ": " + <> pretty (sum durations)) + T.putStrLn ("Total: " <> pretty (fromIntegral (drTotalGrand report))) + where unpack (ISO6801 x) = x + +data HoggleArgs = HoggleArgs Token Integer Integer HoggleCmd +data HoggleCmd = TimeToday + | TimeWeek + | TimeMonth + | StartTimer + | StopTimer + | HowLong + | Info + | Report {reportSince :: String + ,reportUntil :: Maybe String + } + +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' + <> value 8 + <> showDefault + <> help "Number of hours to work per day in avg.") + +todayCmd :: Mod CommandFields HoggleCmd +todayCmd = command "today" (info (pure TimeToday) (progDesc "List today's time.")) + +weekCmd :: Mod CommandFields HoggleCmd +weekCmd = command "week" (info (pure TimeWeek) (progDesc "List this week's time.")) + +monthCmd :: Mod CommandFields HoggleCmd +monthCmd = command "month" (info (pure TimeMonth) (progDesc "List this month's time.")) + +startTimerCmd :: Mod CommandFields HoggleCmd +startTimerCmd = command "start" (info (pure StartTimer) (progDesc "Start a timer.")) + +stopTimerCmd :: Mod CommandFields HoggleCmd +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.")) + +reportCmd :: Mod CommandFields HoggleCmd +reportCmd = command "report" (info (Report <$> strArgument (metavar "SINCE") + <*> optional (strArgument (metavar "UNTIL"))) + (progDesc "Request a report for the specified time range.")) + +infoCmd :: Mod CommandFields HoggleCmd +infoCmd = command "info" (info (pure Info) (progDesc "Display workspaces, clients and projects")) + +hoggleArgsParser :: Parser HoggleArgs +hoggleArgsParser = HoggleArgs + <$> token + <*> lastDowOpt + <*> workHoursOpt + <*> subparser (todayCmd + <> weekCmd + <> monthCmd + <> startTimerCmd + <> stopTimerCmd + <> howLongCmd + <> 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" diff --git a/src/Network/Hoggl.hs b/src/Network/Hoggl.hs new file mode 100644 --- /dev/null +++ b/src/Network/Hoggl.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE OverloadedStrings #-} +module Network.Hoggl (currentTimeEntry + ,stopTimer + ,startTimer + ,getTimer + ,getEntries + ,listWorkspaces + ,listProjects + ,detailedReport + + ,tryStartDefault + ,tryStopRunning + ,prettyCurrent + ,timeEntriesDay + ,timeEntriesToday + ,timeEntriesFromTillNow + ,togglBaseUrl + ,pretty + ,calcDuration + ) where + +import Control.Monad.Error.Class +import Control.Monad.IO.Class (liftIO) +import Data.Bifunctor (first) +import Data.Fixed (mod') +import Data.Proxy (Proxy(Proxy)) +import Data.Text (Text) +import qualified Data.Text.IO as T +import Data.Time.Calendar (Day) +import Data.Time.Clock (UTCTime(..), NominalDiffTime, getCurrentTime, diffUTCTime) +import Formatting (sformat, (%), float) +import Network.HTTP.Client (newManager) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Servant.API +import Servant.Client + +import Network.Hoggl.Types + +togglBaseUrl :: BaseUrl +togglBaseUrl = BaseUrl Https "toggl.com" 443 "/" + +togglApi :: Proxy TogglApi +togglApi = Proxy + +currentTimeEntry' :: Maybe Token -> ClientM TimeEntry +stopTimer' :: Maybe Token -> TimeEntryId -> ClientM TimeEntry +startTimer' :: Maybe Token -> TimeEntryStart -> ClientM TimeEntry +getTimer' :: Maybe Token -> TimeEntryId -> ClientM TimeEntry +getEntries' :: Maybe Token -> Maybe ISO6801 -> Maybe ISO6801 -> ClientM [TimeEntry] +listWorkspaces' :: Maybe Token -> ClientM [Workspace] +listProjects' :: Maybe Token -> WorkspaceId -> ClientM [Project] +(currentTimeEntry' :<|> stopTimer' :<|> startTimer' :<|> getTimer' :<|> getEntries' :<|> listWorkspaces' :<|> listProjects') = + client togglApi + +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 e = throwError e + +stopTimer :: Token -> TimeEntryId -> ClientM TimeEntry +stopTimer tk = stopTimer' (Just tk) + +startTimer :: Token -> TimeEntryStart -> ClientM TimeEntry +startTimer tk = startTimer' (Just tk) + +getTimer :: Token -> TimeEntryId -> ClientM TimeEntry +getTimer tk = getTimer' (Just tk) + +getEntries :: Token -> ISO6801 -> ISO6801 -> ClientM [TimeEntry] +getEntries tk start end = getEntries' (Just tk) (Just start) (Just end) + +listWorkspaces :: Token -> ClientM [Workspace] +listWorkspaces token = listWorkspaces' (Just token) + +listProjects :: Token -> WorkspaceId -> ClientM [Project] +listProjects token = listProjects' (Just token) + +togglReportApi :: Proxy ToggleReportApi +togglReportApi = Proxy + +detailedReport' :: Maybe Token + -> Maybe WorkspaceId + -> Maybe ISO6801Date + -> Maybe ISO6801Date + -> Maybe Text + -> ClientM DetailedReport +detailedReport' = client togglReportApi + +detailedReport :: Token + -> WorkspaceId + -> ISO6801Date + -> ISO6801Date + -> Text + -> ClientM DetailedReport +detailedReport tk wid since untl userAgent = detailedReport' (Just tk) + (Just wid) + (Just since) + (Just untl) + (Just userAgent) + +defaultTimeEntry :: TimeEntryStart +defaultTimeEntry = TES {tesDescription = Nothing + ,tesTags = [] + ,tesPid = Nothing + ,tesCreatedWith = "hoggl" + } + +calcDuration :: TimeEntry -> IO NominalDiffTime +calcDuration te = + case teStop te of + Just _ -> return (teDuration te) + Nothing -> do + stop <- getCurrentTime + return (diffUTCTime stop start) + where ISO6801 start = teStart te + +pretty :: RealFrac n => n -> Text +pretty n = + sformat (float % "h " % float % "m") + (floorInt $ n / 60 / 60) + (floorInt $ (n / 60) `mod'` 60) + + where floorInt :: RealFrac n => n -> Integer + floorInt = floor + +prettyCurrent :: Token -> IO () +prettyCurrent authorization = do + manager <- newManager tlsManagerSettings + etimer <- runClientM (currentTimeEntry authorization) $ ClientEnv manager 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 + currentTimer <- runClientM (currentTimeEntry authorization) clientEnv + case currentTimer of + Right Nothing -> + first ServantError <$> runClientM (startTimer authorization defaultTimeEntry) clientEnv + Right (Just _) -> return (Left (HogglError "There already is a running timer!")) + Left e -> return (Left (ServantError e)) + +tryStopRunning :: Token -> IO (Either HogglError TimeEntry) +tryStopRunning authorization = do + manager <- newManager tlsManagerSettings + let clientEnv = ClientEnv manager togglBaseUrl + currentTimer <- runClientM (currentTimeEntry authorization) clientEnv + case currentTimer of + Right (Just TimeEntry {teId = tid}) -> + first ServantError <$> runClientM (stopTimer authorization tid) clientEnv + Right Nothing -> return (Left (HogglError "No timer running!")) + Left e -> return (Left (ServantError e)) + +timeEntriesDay :: Token -> Day -> ClientM [TimeEntry] +timeEntriesDay authorization day = do + let start = UTCTime { utctDay = day, utctDayTime = 0 } + end = start { utctDay = day, utctDayTime = 86399 } + getEntries authorization (ISO6801 start) (ISO6801 end) + +timeEntriesToday :: Token -> ClientM [TimeEntry] +timeEntriesToday authorization = do + now <- liftIO getCurrentTime + timeEntriesDay authorization (utctDay now) + +timeEntriesFromTillNow :: Token -> Day -> ClientM [TimeEntry] +timeEntriesFromTillNow authorization start = do + now <- liftIO getCurrentTime + getEntries authorization (ISO6801 (UTCTime start 0)) (ISO6801 now) diff --git a/src/Network/Hoggl/Pretty.hs b/src/Network/Hoggl/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/Network/Hoggl/Pretty.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RecordWildCards #-} +module Network.Hoggl.Pretty (workspacePretty) where + +import Data.Monoid ((<>)) +import qualified Data.Text as T + +import Network.Hoggl.Types + +workspacePretty :: Workspace -> String +workspacePretty Workspace {..} = show wid <> " (" <> T.unpack wsName <> ")" + where (WID wid) = wsId diff --git a/src/Network/Hoggl/Types.hs b/src/Network/Hoggl/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Hoggl/Types.hs @@ -0,0 +1,200 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +module Network.Hoggl.Types (TimeEntryId(..) + ,Token(..) + ,HogglError(..) + ,TimeEntryStart(..) + ,TimeEntry(..) + ,ISO6801(..) + ,ISO6801Date(..) + ,Workspace(..) + ,WorkspaceId(..) + ,Project(..) + ,ProjectId(..) + ,DetailedReport(..) + ,TogglApi + ,ToggleReportApi + + ,parseTimeStamp) where + +import Codec.Binary.Base64.String (encode) +import Control.Applicative ((<|>)) +import Control.Monad (mzero) +import Data.Aeson (FromJSON(..), Value (..), (.:), (.:?), ToJSON(..), object, (.=), (.!=)) +import Data.Aeson.Types (Parser) +import qualified Data.HashMap.Strict as H +import Data.Hashable (Hashable) +import Data.Monoid ((<>)) +import Data.String (IsString) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Calendar (Day) +import Data.Time.Clock (UTCTime, NominalDiffTime) +import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM, iso8601DateFormat) +import Servant.API +import Servant.Client + +newtype TimeEntryId = TID Integer deriving (Show,Eq,FromJSON,ToHttpApiData) +newtype WorkspaceId = WID Integer deriving (Show,Eq,FromJSON,ToHttpApiData) +newtype ProjectId = PID Integer deriving (Show,Eq,FromJSON,ToHttpApiData) +newtype ApiToken = ApiToken String deriving (IsString) +newtype ISO6801 = ISO6801 UTCTime deriving (Show,Eq,Ord) +newtype ISO6801Date = ISO6801Date Day deriving (Show,Eq,Ord) + +instance ToHttpApiData ISO6801 where + toUrlPiece (ISO6801 t) = + toUrlPiece . addColon $ formatTime defaultTimeLocale "%Y-%m-%dT%H%::%M:%S%z" t + +addColon :: String -> String +addColon s = reverse (p2 <> ":" <> su) + where sr = reverse s + p2 = take 2 sr + su = drop 2 sr + +instance FromJSON ISO6801 where + parseJSON (String s) = ISO6801 <$> parseTimeStamp s + parseJSON _ = mzero + +parseTimeStamp :: Monad m => Text -> m UTCTime +parseTimeStamp ts = + parseTimeM True + defaultTimeLocale + (iso8601DateFormat (Just "%H:%M:%S%z")) + (removeColon (T.unpack ts)) + where removeColon s = + reverse (dropWhile (/= '+') (reverse s)) ++ + reverse (filter (/= ':') (takeWhile (/= '+') (reverse s))) + + +instance ToHttpApiData ISO6801Date where + toUrlPiece (ISO6801Date day) = toUrlPiece (formatTime defaultTimeLocale "%Y-%m-%d" day) + +data Token = Api String + | UserPass String String + deriving (Show,Eq) + +instance ToHttpApiData Token where + 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 TimeEntryStart = TES { tesDescription :: Maybe Text + , tesTags :: [Text] + , tesPid :: Maybe Integer + , tesCreatedWith :: Text + } deriving (Show,Eq) + +instance ToJSON TimeEntryStart where + toJSON (TES desc tags pid createdWith) = object ["time_entry" .= object ["description" .= desc + ,"tags" .= tags + ,"pid" .= pid + ,"created_with" .= createdWith]] + +data TimeEntry = TimeEntry {teId :: TimeEntryId + ,teProjectId :: Maybe ProjectId + ,teProject :: Maybe Text + ,teClient :: Maybe Text + ,teStart :: ISO6801 + ,teStop :: Maybe ISO6801 + ,teDuration :: NominalDiffTime + ,teDescription :: Maybe Text + }deriving (Show,Eq) + +instance FromJSON TimeEntry where + parseJSON v@(Object o) = ((o .: "data") >>= p) <|> p v + where p (Object d) = TimeEntry <$> d .: "id" + <*> d .:?? "pid" + <*> d .:?? "project" + <*> d .:?? "client" + <*> d .: "start" + <*> (d .: "stop" <|> d.:?? "end") + <*> (convert <$> ((d .: "duration") <|> ((`div` 1000) <$> (d .: "dur")))) + <*> d .:? "description" + p _ = mzero + convert :: Integer -> NominalDiffTime + convert = fromIntegral + parseJSON _ = mzero + +(.:??) :: (FromJSON a, Hashable k, Eq k) => H.HashMap k Value -> k -> Parser (Maybe a) +obj .:?? key = case H.lookup key obj of + Nothing -> pure Nothing + Just Null -> pure Nothing + Just v -> Just <$> parseJSON v +{-# INLINE (.:??) #-} + +data Workspace = Workspace {wsId :: WorkspaceId + ,wsName :: Text + ,wsPremium :: Bool + ,wsAdmin :: Bool + ,wsDefaultHourlyRate :: Double + ,wsDefaultCurrency :: Text + ,wsRounding :: Int + ,wsRoundingMinutes :: Int + ,wsAt :: ISO6801 + } deriving (Show,Eq) + +instance FromJSON Workspace where + parseJSON (Object o) = Workspace <$> o .: "id" + <*> o .: "name" + <*> o .: "premium" + <*> o .: "admin" + <*> o .: "default_hourly_rate" + <*> o .: "default_currency" + <*> o .: "rounding" + <*> o .: "rounding_minutes" + <*> o .: "at" + parseJSON _ = mzero + +data Project = Project { prId :: ProjectId + , prWsId :: WorkspaceId + , prName :: Text + , prBillable :: Bool + , prPrivate :: Bool + , prActive :: Bool + , prAt :: ISO6801 + } + +instance FromJSON Project where + parseJSON (Object o) = Project <$> o .: "id" + <*> o .: "wid" + <*> o .: "name" + <*> o .: "billable" + <*> o .: "is_private" + <*> o .: "active" + <*> o .: "at" + parseJSON _ = mzero + +data DetailedReport = DetailedReport {drPerPage :: Int + ,drTotalCount :: Int + ,drTotalBillable :: Double + ,drTotalGrand :: Integer + ,drData :: [TimeEntry] + } deriving (Show,Eq) + +instance FromJSON DetailedReport where + parseJSON (Object o) = DetailedReport <$> o .: "per_page" + <*> o .: "total_count" + <*> o .:? "total_billable" .!= 0 + <*> ((`div` 1000 ) <$> (o .: "total_grand")) + <*> o .: "data" + parseJSON _ = mzero + +type WithAuth a = "api" :> "v8" :> Header "Authorization" Token :> a + +type Current = WithAuth ("time_entries" :> "current" :> Get '[JSON] TimeEntry) +type Stop = WithAuth ("time_entries" :> Capture "time_entry_id" TimeEntryId :> "stop" :> Put '[JSON] TimeEntry) +type Start = WithAuth ("time_entries" :> "start" :> ReqBody '[JSON] TimeEntryStart :> Post '[JSON] TimeEntry) +type Details = WithAuth ("time_entries" :> Capture "time_entry_id" TimeEntryId :> Get '[JSON] TimeEntry) +type GetEntries = WithAuth ("time_entries" :> QueryParam "start_date" ISO6801 :> QueryParam "end_date" ISO6801 :> Get '[JSON] [TimeEntry]) +type ListWorkspaces = WithAuth ("workspaces" :> Get '[JSON] [Workspace]) +type ListProjects = WithAuth ("workspaces" :> Capture "workspace_id" WorkspaceId :> "projects" :> Get '[JSON] [Project]) + +type TogglApi = Current :<|> Stop :<|> Start :<|> Details :<|> GetEntries :<|> ListWorkspaces :<|> ListProjects + +type GetDetailedReport = "reports" :> "api" :> "v2" :> "details" :> Header "Authorization" Token :> QueryParam "workspace_id" WorkspaceId :> QueryParam "since" ISO6801Date :> QueryParam "until" ISO6801Date :> QueryParam "user_agent" Text :> Get '[JSON] DetailedReport + +type ToggleReportApi = GetDetailedReport