{-# 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)