hoggl (empty) → 0.2.0.0
raw patch · 7 files changed
+687/−0 lines, 7 filesdep +aesondep +basedep +base64-stringsetup-changed
Dependencies added: aeson, base, base64-string, either, formatting, hashable, hoggl, http-client, http-client-tls, mtl, optparse-applicative, servant, servant-client, text, time, transformers, unordered-containers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- hoggl.cabal +56/−0
- main/Main.hs +216/−0
- src/Network/Hoggl.hs +172/−0
- src/Network/Hoggl/Pretty.hs +11/−0
- src/Network/Hoggl/Types.hs +200/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hoggl.cabal view
@@ -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
+ main/Main.hs view
@@ -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"
+ src/Network/Hoggl.hs view
@@ -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)
+ src/Network/Hoggl/Pretty.hs view
@@ -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
+ src/Network/Hoggl/Types.hs view
@@ -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