From fbdcd0543c273e016e353b4b2981da4d2983105d Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Thu, 18 Jan 2024 15:23:59 -0700 Subject: [PATCH] autoformat with fourmolu --- library/Asana/Api/CustomField.hs | 72 +++---- library/Asana/Api/Gid.hs | 23 ++- library/Asana/Api/Named.hs | 12 +- library/Asana/Api/Prelude.hs | 18 +- library/Asana/Api/Project.hs | 14 +- library/Asana/Api/Request.hs | 335 ++++++++++++++++--------------- library/Asana/Api/Tag.hs | 12 +- library/Asana/Api/Task.hs | 166 +++++++-------- library/Asana/Api/Task/Search.hs | 68 +++---- 9 files changed, 371 insertions(+), 349 deletions(-) diff --git a/library/Asana/Api/CustomField.hs b/library/Asana/Api/CustomField.hs index e6fed55..845cb97 100644 --- a/library/Asana/Api/CustomField.hs +++ b/library/Asana/Api/CustomField.hs @@ -1,15 +1,15 @@ module Asana.Api.CustomField - ( CustomField(..) - , CustomFields(..) - , customEnumId - , EnumOption(..) - , putCustomField - , putCustomFields - ) where - -import Asana.Api.Prelude + ( CustomField (..), + CustomFields (..), + customEnumId, + EnumOption (..), + putCustomField, + putCustomFields, + ) +where import Asana.Api.Gid (Gid, gidToText) +import Asana.Api.Prelude import Asana.Api.Request import Data.Aeson import Data.Aeson.Casing (aesonPrefix, snakeCase) @@ -22,27 +22,28 @@ data CustomField = CustomNumber Gid Text (Maybe Scientific) | CustomEnum Gid Text [EnumOption] (Maybe Text) | CustomText Gid Text (Maybe Text) - | Other -- ^ Unexpected types dumped here + | -- | Unexpected types dumped here + Other deriving stock (Eq, Generic, Show) -newtype CustomFields = CustomFields { getCustomFields :: [CustomField] } +newtype CustomFields = CustomFields {getCustomFields :: [CustomField]} deriving stock (Show, Eq) deriving newtype (FromJSON) instance ToJSON CustomFields where toJSON (CustomFields fields) = object $ concatMap toPair fields - where - toPair = \case - CustomNumber gid _ n -> [gidToKey gid .= n] - e@(CustomEnum gid _ _ _) -> [gidToKey gid .= customEnumId e] - _ -> [] + where + toPair = \case + CustomNumber gid _ n -> [gidToKey gid .= n] + e@(CustomEnum gid _ _ _) -> [gidToKey gid .= customEnumId e] + _ -> [] - -- fromString will give us Text for aeson-1.x and Key for aeson-2.x - gidToKey = fromString . T.unpack . gidToText + -- fromString will give us Text for aeson-1.x and Key for aeson-2.x + gidToKey = fromString . T.unpack . gidToText data EnumOption = EnumOption - { eoGid :: Gid - , eoName :: Text + { eoGid :: Gid, + eoName :: Text } deriving stock (Eq, Generic, Show) @@ -54,7 +55,6 @@ instance FromJSON EnumOption where -- - Must be a @'CustomEnum'@ -- - Must have a value -- - Must have an option with the same name as that value --- customEnumId :: CustomField -> Maybe Gid customEnumId (CustomEnum _ _ opts mValue) = do value <- mValue @@ -77,22 +77,24 @@ instance FromJSON CustomField where <*> (o .: "name") <*> (o .: "enum_options") <*> case value of - Object vo -> vo .:? "name" - _ -> pure Nothing + Object vo -> vo .:? "name" + _ -> pure Nothing _ -> pure Other -putCustomField - :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) - => Gid - -> CustomField - -> m () +putCustomField :: + (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) => + Gid -> + CustomField -> + m () putCustomField taskId = putCustomFields taskId . CustomFields . pure -putCustomFields - :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) - => Gid - -> CustomFields - -> m () +putCustomFields :: + (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) => + Gid -> + CustomFields -> + m () putCustomFields taskId fields = - void $ put ("/tasks/" <> T.unpack (gidToText taskId)) $ ApiData - (object ["custom_fields" .= fields]) + void $ + put ("/tasks/" <> T.unpack (gidToText taskId)) $ + ApiData + (object ["custom_fields" .= fields]) diff --git a/library/Asana/Api/Gid.hs b/library/Asana/Api/Gid.hs index 1252a96..0410dfb 100644 --- a/library/Asana/Api/Gid.hs +++ b/library/Asana/Api/Gid.hs @@ -1,24 +1,29 @@ -- | A globally unique identifier module Asana.Api.Gid - ( Gid - , AsanaReference(..) - , gidToText - , textToGid - ) where + ( Gid, + AsanaReference (..), + gidToText, + textToGid, + ) +where import Asana.Api.Prelude - import Data.Aeson - (FromJSON(..), FromJSONKey, ToJSON, ToJSONKey, genericParseJSON) + ( FromJSON (..), + FromJSONKey, + ToJSON, + ToJSONKey, + genericParseJSON, + ) import Data.Aeson.Casing (aesonPrefix, snakeCase) import Data.Hashable (Hashable) -newtype Gid = Gid { gidToText :: Text } +newtype Gid = Gid {gidToText :: Text} deriving stock (Eq, Generic, Show) deriving newtype (FromJSON, ToJSON, ToJSONKey, FromJSONKey, Hashable) -- | An object @{ gid: }@ -newtype AsanaReference = AsanaReference { arGid :: Gid } +newtype AsanaReference = AsanaReference {arGid :: Gid} deriving stock (Eq, Generic, Show) instance FromJSON AsanaReference where diff --git a/library/Asana/Api/Named.hs b/library/Asana/Api/Named.hs index 0284dc2..952443e 100644 --- a/library/Asana/Api/Named.hs +++ b/library/Asana/Api/Named.hs @@ -1,17 +1,17 @@ -- | Anything with a compact @{ id, name }@ representation module Asana.Api.Named - ( Named(..) - ) where - -import Asana.Api.Prelude + ( Named (..), + ) +where import Asana.Api.Gid (Gid) +import Asana.Api.Prelude import Data.Aeson (FromJSON, genericParseJSON, parseJSON) import Data.Aeson.Casing (aesonPrefix, snakeCase) data Named = Named - { nGid :: Gid - , nName :: Text + { nGid :: Gid, + nName :: Text } deriving stock (Eq, Generic, Show) diff --git a/library/Asana/Api/Prelude.hs b/library/Asana/Api/Prelude.hs index b529f89..3f6ce39 100644 --- a/library/Asana/Api/Prelude.hs +++ b/library/Asana/Api/Prelude.hs @@ -1,8 +1,7 @@ module Asana.Api.Prelude - ( module X - ) where - -import Prelude as X + ( module X, + ) +where import Control.Arrow as X ((&&&), (***)) import Control.Monad.IO.Unlift as X (MonadUnliftIO) @@ -12,11 +11,18 @@ import Data.Bifunctor as X (first, second) import Data.ByteString as X (ByteString) import Data.Foldable as X (for_) import Data.Maybe as X - (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe) + ( catMaybes, + fromMaybe, + isJust, + isNothing, + listToMaybe, + mapMaybe, + ) import Data.Text as X (Text, pack, unpack) import Data.Traversable as X (for) import GHC.Generics as X (Generic) import Lens.Micro as X (Lens', lens) import Lens.Micro.Mtl as X (view) import Text.Read as X (readMaybe) -import UnliftIO.Exception as X (Exception(..), catch, throwIO) +import UnliftIO.Exception as X (Exception (..), catch, throwIO) +import Prelude as X diff --git a/library/Asana/Api/Project.hs b/library/Asana/Api/Project.hs index 7cf14f4..3037e08 100644 --- a/library/Asana/Api/Project.hs +++ b/library/Asana/Api/Project.hs @@ -1,18 +1,18 @@ module Asana.Api.Project - ( Project(..) - ) where - -import Asana.Api.Prelude + ( Project (..), + ) +where import Asana.Api.Gid (Gid) +import Asana.Api.Prelude import Data.Aeson (FromJSON, genericParseJSON, parseJSON) import Data.Aeson.Casing (aesonPrefix, snakeCase) import Data.Time (UTCTime) data Project = Project - { pGid :: Gid - , pName :: Text - , pCreatedAt :: UTCTime + { pGid :: Gid, + pName :: Text, + pCreatedAt :: UTCTime } deriving stock (Generic, Show) diff --git a/library/Asana/Api/Request.hs b/library/Asana/Api/Request.hs index 5ea3382..fc403b1 100644 --- a/library/Asana/Api/Request.hs +++ b/library/Asana/Api/Request.hs @@ -1,20 +1,20 @@ module Asana.Api.Request - ( AsanaAccessKey(..) - , HasAsanaAccessKey(..) - , Single(..) - , Page(..) - , NextPage(..) - , ApiData(..) - , getAll - , getAllParams - , getSingle - , put - , post - , maxRequests - ) where + ( AsanaAccessKey (..), + HasAsanaAccessKey (..), + Single (..), + Page (..), + NextPage (..), + ApiData (..), + getAll, + getAllParams, + getSingle, + put, + post, + maxRequests, + ) +where import Asana.Api.Prelude - import Data.Aeson import Data.Aeson.Casing (aesonPrefix, snakeCase) import qualified Data.ByteString.Lazy as BSL @@ -22,23 +22,23 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T import Network.HTTP.Simple - ( JSONException(JSONConversionException, JSONParseException) - , Request - , Response - , addRequestHeader - , getResponseBody - , getResponseHeader - , getResponseStatusCode - , httpJSON - , parseRequest_ - , setRequestBodyJSON - , setRequestMethod + ( JSONException (JSONConversionException, JSONParseException), + Request, + Response, + addRequestHeader, + getResponseBody, + getResponseHeader, + getResponseStatusCode, + httpJSON, + parseRequest_, + setRequestBodyJSON, + setRequestMethod, ) import UnliftIO.Concurrent (threadDelay) newtype AsanaAccessKey = AsanaAccessKey - { unAsanaAccessKey :: Text - } + { unAsanaAccessKey :: Text + } class HasAsanaAccessKey env where asanaAccessKeyL :: Lens' env AsanaAccessKey @@ -54,26 +54,26 @@ newtype Single a = Single { sData :: a } deriving newtype (Eq, Show) - deriving stock Generic + deriving stock (Generic) -instance FromJSON a => FromJSON (Single a) where +instance (FromJSON a) => FromJSON (Single a) where parseJSON = genericParseJSON $ aesonPrefix snakeCase -- | Type for a list-resource response, containing @{ data: [{ ... }] }@ data Page a = Page - { pData :: [a] - , pNextPage :: Maybe NextPage + { pData :: [a], + pNextPage :: Maybe NextPage } deriving stock (Eq, Generic, Show) -instance FromJSON a => FromJSON (Page a) where +instance (FromJSON a) => FromJSON (Page a) where parseJSON = genericParseJSON $ aesonPrefix snakeCase -- | The @next_page@ element of a paginated response data NextPage = NextPage - { npOffset :: Text - , npPath :: Text - , npUri :: Text + { npOffset :: Text, + npPath :: Text, + npUri :: Text } deriving stock (Eq, Generic, Show) @@ -85,137 +85,142 @@ newtype ApiData a = ApiData { adData :: a } deriving newtype (Show, Eq) - deriving stock Generic + deriving stock (Generic) -instance FromJSON a => FromJSON (ApiData a) where +instance (FromJSON a) => FromJSON (ApiData a) where parseJSON = genericParseJSON $ aesonPrefix snakeCase -instance ToJSON a => ToJSON (ApiData a) where +instance (ToJSON a) => ToJSON (ApiData a) where toJSON = genericToJSON $ aesonPrefix snakeCase toEncoding = genericToEncoding $ aesonPrefix snakeCase -- | Naively GET all pages of a paginated resource -getAll - :: ( MonadUnliftIO m - , MonadLogger m - , MonadReader env m - , HasAsanaAccessKey env - , FromJSON a - ) - => String - -> m [a] +getAll :: + ( MonadUnliftIO m, + MonadLogger m, + MonadReader env m, + HasAsanaAccessKey env, + FromJSON a + ) => + String -> + m [a] getAll path = getAllParams path [] -getAllParams - :: ( MonadUnliftIO m - , MonadLogger m - , MonadReader env m - , HasAsanaAccessKey env - , FromJSON a - ) - => String - -> [(String, String)] - -> m [a] +getAllParams :: + ( MonadUnliftIO m, + MonadLogger m, + MonadReader env m, + HasAsanaAccessKey env, + FromJSON a + ) => + String -> + [(String, String)] -> + m [a] getAllParams path params = go Nothing - where - go mOffset = do - Page d mNextPage <- get path params 50 mOffset + where + go mOffset = do + Page d mNextPage <- get path params 50 mOffset - maybe (pure d) (fmap (d ++) . go . Just . T.unpack . npOffset) mNextPage + maybe (pure d) (fmap (d ++) . go . Just . T.unpack . npOffset) mNextPage -- | Get a single resource -getSingle - :: ( MonadUnliftIO m - , MonadLogger m - , MonadReader env m - , HasAsanaAccessKey env - , FromJSON a - ) - => String - -> m a +getSingle :: + ( MonadUnliftIO m, + MonadLogger m, + MonadReader env m, + HasAsanaAccessKey env, + FromJSON a + ) => + String -> + m a getSingle path = sData <$> get path [] 1 Nothing -get - :: ( MonadUnliftIO m - , MonadLogger m - , MonadReader env m - , HasAsanaAccessKey env - , FromJSON a - ) - => String - -> [(String, String)] - -> Int - -> Maybe String - -> m a +get :: + ( MonadUnliftIO m, + MonadLogger m, + MonadReader env m, + HasAsanaAccessKey env, + FromJSON a + ) => + String -> + [(String, String)] -> + Int -> + Maybe String -> + m a get path params limit mOffset = do AsanaAccessKey key <- view asanaAccessKeyL - let - request = - parseRequest_ - $ "https://app.asana.com/api/1.0" - <> path - <> "?limit=" - <> show limit -- Ignored on not paging responses - <> maybe "" ("&offset=" <>) mOffset - <> concatMap (\(k, v) -> "&" <> k <> "=" <> v) params + let request = + parseRequest_ $ + "https://app.asana.com/api/1.0" + <> path + <> "?limit=" + <> show limit -- Ignored on not paging responses + <> maybe "" ("&offset=" <>) mOffset + <> concatMap (\(k, v) -> "&" <> k <> "=" <> v) params response <- retry 50 $ httpJSON (addAuthorization key request) - when (300 <= getResponseStatusCode response) - $ logWarnNS "Asana" - $ "GET failed, status: " - <> pack (show $ getResponseStatusCode response) + when (300 <= getResponseStatusCode response) $ + logWarnNS "Asana" $ + "GET failed, status: " + <> pack (show $ getResponseStatusCode response) pure $ getResponseBody response -put - :: ( MonadUnliftIO m - , MonadLogger m - , MonadReader env m - , HasAsanaAccessKey env - , ToJSON a - ) - => String - -> a - -> m Value +put :: + ( MonadUnliftIO m, + MonadLogger m, + MonadReader env m, + HasAsanaAccessKey env, + ToJSON a + ) => + String -> + a -> + m Value put = httpAction "PUT" -post - :: ( MonadUnliftIO m - , MonadLogger m - , MonadReader env m - , HasAsanaAccessKey env - , ToJSON a - ) - => String - -> a - -> m Value +post :: + ( MonadUnliftIO m, + MonadLogger m, + MonadReader env m, + HasAsanaAccessKey env, + ToJSON a + ) => + String -> + a -> + m Value post = httpAction "POST" -httpAction - :: ( MonadUnliftIO m - , MonadLogger m - , MonadReader env m - , HasAsanaAccessKey env - , ToJSON a - ) - => ByteString - -> String - -> a - -> m Value +httpAction :: + ( MonadUnliftIO m, + MonadLogger m, + MonadReader env m, + HasAsanaAccessKey env, + ToJSON a + ) => + ByteString -> + String -> + a -> + m Value httpAction verb path payload = do AsanaAccessKey key <- view asanaAccessKeyL let request = parseRequest_ $ "https://app.asana.com/api/1.0" <> path - response <- retry 10 $ httpJSON - (setRequestMethod verb . setRequestBodyJSON payload $ addAuthorization - key - request - ) - when (300 <= getResponseStatusCode response) $ logWarnNS "Asana" $ mconcat - [ "Request failed" - , "\n method: " <> T.decodeUtf8 verb - , "\n status: " <> pack (show $ getResponseStatusCode response) - , "\n body : " <> T.decodeUtf8 - (BSL.toStrict $ encode $ toJSON $ getResponseBody @Value response) - ] + response <- + retry 10 $ + httpJSON + ( setRequestMethod verb . setRequestBodyJSON payload $ + addAuthorization + key + request + ) + when (300 <= getResponseStatusCode response) $ + logWarnNS "Asana" $ + mconcat + [ "Request failed", + "\n method: " <> T.decodeUtf8 verb, + "\n status: " <> pack (show $ getResponseStatusCode response), + "\n body : " + <> T.decodeUtf8 + (BSL.toStrict $ encode $ toJSON $ getResponseBody @Value response) + ] pure $ getResponseBody response @@ -223,38 +228,38 @@ addAuthorization :: Text -> Request -> Request addAuthorization key = addRequestHeader "Authorization" $ "Bearer " <> T.encodeUtf8 key -retry - :: forall a m - . (MonadUnliftIO m, MonadLogger m) - => Int - -> m (Response a) - -> m (Response a) +retry :: + forall a m. + (MonadUnliftIO m, MonadLogger m) => + Int -> + m (Response a) -> + m (Response a) retry attempt go | attempt <= 0 = go | otherwise = handler =<< go `catch` handleParseError - where - handleParseError :: JSONException -> m (Response a) - handleParseError e = case e of - JSONParseException _ rsp _ -> orThrow e rsp - JSONConversionException _ rsp _ -> orThrow e rsp + where + handleParseError :: JSONException -> m (Response a) + handleParseError e = case e of + JSONParseException _ rsp _ -> orThrow e rsp + JSONConversionException _ rsp _ -> orThrow e rsp - orThrow :: Exception e => e -> Response b -> m (Response a) - orThrow e response - | getResponseStatusCode response == 429 = do - let seconds = getResponseDelay response - logWarnNS "Asana" $ "Retrying after " <> pack (show seconds) <> " seconds" - threadDelay $ seconds * 1000000 - retry (pred attempt) go - | otherwise = liftIO $ throwIO e + orThrow :: (Exception e) => e -> Response b -> m (Response a) + orThrow e response + | getResponseStatusCode response == 429 = do + let seconds = getResponseDelay response + logWarnNS "Asana" $ "Retrying after " <> pack (show seconds) <> " seconds" + threadDelay $ seconds * 1000000 + retry (pred attempt) go + | otherwise = liftIO $ throwIO e - handler :: Response a -> m (Response a) - handler response - | getResponseStatusCode response == 429 = do - let seconds = getResponseDelay response - logWarnNS "Asana" $ "Retrying after " <> pack (show seconds) <> " seconds" - threadDelay $ seconds * 100000 - retry (pred attempt) go - | otherwise = pure response + handler :: Response a -> m (Response a) + handler response + | getResponseStatusCode response == 429 = do + let seconds = getResponseDelay response + logWarnNS "Asana" $ "Retrying after " <> pack (show seconds) <> " seconds" + threadDelay $ seconds * 100000 + retry (pred attempt) go + | otherwise = pure response getResponseDelay :: Response a -> Int getResponseDelay = diff --git a/library/Asana/Api/Tag.hs b/library/Asana/Api/Tag.hs index 043c41f..1187087 100644 --- a/library/Asana/Api/Tag.hs +++ b/library/Asana/Api/Tag.hs @@ -1,16 +1,16 @@ module Asana.Api.Tag - ( Tag(..) - ) where - -import Asana.Api.Prelude + ( Tag (..), + ) +where import Asana.Api.Gid +import Asana.Api.Prelude import Data.Aeson import Data.Aeson.Casing (aesonPrefix, snakeCase) data Tag = Tag - { tGid :: Gid - , tName :: Text + { tGid :: Gid, + tName :: Text } deriving stock (Eq, Generic, Show) diff --git a/library/Asana/Api/Task.hs b/library/Asana/Api/Task.hs index b9e368b..10ed634 100644 --- a/library/Asana/Api/Task.hs +++ b/library/Asana/Api/Task.hs @@ -1,25 +1,25 @@ module Asana.Api.Task - ( Task(..) - , Membership(..) - , TaskStatusFilter(..) - , ResourceSubtype(..) - , PostTask(..) - , getTask - , getProjectTasks - , getProjectTasksCompletedSince - , postTask - , addTag - , putCompleted - , taskUrl - , extractNumberField - , extractEnumField - ) where - -import Asana.Api.Prelude + ( Task (..), + Membership (..), + TaskStatusFilter (..), + ResourceSubtype (..), + PostTask (..), + getTask, + getProjectTasks, + getProjectTasksCompletedSince, + postTask, + addTag, + putCompleted, + taskUrl, + extractNumberField, + extractEnumField, + ) +where import Asana.Api.CustomField import Asana.Api.Gid import Asana.Api.Named +import Asana.Api.Prelude import Asana.Api.Request import Asana.Api.Tag import Data.Aeson @@ -30,8 +30,8 @@ import Data.Time (UTCTime, getCurrentTime) import Data.Time.ISO8601 (formatISO8601) data Membership = Membership - { mProject :: Named - , mSection :: Maybe Named + { mProject :: Named, + mSection :: Maybe Named } deriving stock (Eq, Generic, Show) @@ -43,21 +43,21 @@ data ResourceSubtype = DefaultTask | Milestone | Section instance FromJSON ResourceSubtype where parseJSON = - genericParseJSON $ defaultOptions { constructorTagModifier = snakeCase } + genericParseJSON $ defaultOptions {constructorTagModifier = snakeCase} data Task = Task - { tAssignee :: Maybe Named - , tName :: Text - , tCompleted :: Bool - , tCompletedAt :: Maybe UTCTime - , tCreatedAt :: UTCTime - , tCustomFields :: CustomFields - , tMemberships :: [Membership] - , tGid :: Gid - , tResourceSubtype :: ResourceSubtype - , tNotes :: Text - , tProjects :: [AsanaReference] - , tTags :: [Tag] + { tAssignee :: Maybe Named, + tName :: Text, + tCompleted :: Bool, + tCompletedAt :: Maybe UTCTime, + tCreatedAt :: UTCTime, + tCustomFields :: CustomFields, + tMemberships :: [Membership], + tGid :: Gid, + tResourceSubtype :: ResourceSubtype, + tNotes :: Text, + tProjects :: [AsanaReference], + tTags :: [Tag] } deriving stock (Eq, Generic, Show) @@ -65,20 +65,20 @@ instance FromJSON Task where parseJSON = genericParseJSON $ aesonPrefix snakeCase -- | Return all details for a task by id -getTask - :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) - => Gid - -> m Task +getTask :: + (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) => + Gid -> + m Task getTask taskId = getSingle $ "/tasks/" <> T.unpack (gidToText taskId) data PostTask = PostTask - { ptProjects :: [Gid] - , ptCustomFields :: HashMap Gid Text - , ptName :: Text - , ptNotes :: Text - , ptParent :: Maybe Gid + { ptProjects :: [Gid], + ptCustomFields :: HashMap Gid Text, + ptName :: Text, + ptNotes :: Text, + ptParent :: Maybe Gid } - deriving stock Generic + deriving stock (Generic) instance FromJSON PostTask where parseJSON = genericParseJSON $ aesonPrefix snakeCase @@ -88,10 +88,10 @@ instance ToJSON PostTask where toEncoding = genericToEncoding $ aesonPrefix snakeCase -- | Create a new 'Task' -postTask - :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) - => PostTask - -> m (Result Task) +postTask :: + (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) => + PostTask -> + m (Result Task) postTask body = fmap adData . fromJSON <$> post "/tasks" (ApiData body) -- | Return compact task details for a project @@ -99,51 +99,55 @@ postTask body = fmap adData . fromJSON <$> post "/tasks" (ApiData body) -- Iterating ourselves and returning @['Task']@ is a better interface but -- precludes us logging things each time we request an element. So we return -- @'Named'@ for now and let the caller use @'getTask'@ themselves. --- -getProjectTasks - :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) - => Gid - -> TaskStatusFilter - -> m [Named] +getProjectTasks :: + (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) => + Gid -> + TaskStatusFilter -> + m [Named] getProjectTasks projectId taskStatusFilter = do now <- liftIO getCurrentTime getAllParams (T.unpack $ "/projects/" <> gidToText projectId <> "/tasks") (completedSince now) - - where - completedSince now = case taskStatusFilter of - AllTasks -> [] - IncompletedTasks -> [("completed_since", formatISO8601 now)] + where + completedSince now = case taskStatusFilter of + AllTasks -> [] + IncompletedTasks -> [("completed_since", formatISO8601 now)] data TaskStatusFilter = IncompletedTasks | AllTasks -getProjectTasksCompletedSince - :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) - => Gid - -> UTCTime - -> m [Named] -getProjectTasksCompletedSince projectId since = getAllParams - (T.unpack $ "/projects/" <> gidToText projectId <> "/tasks") - [("completed_since", formatISO8601 since)] - -addTag - :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) - => Gid - -> Gid -- ^ Tag - -> m () +getProjectTasksCompletedSince :: + (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) => + Gid -> + UTCTime -> + m [Named] +getProjectTasksCompletedSince projectId since = + getAllParams + (T.unpack $ "/projects/" <> gidToText projectId <> "/tasks") + [("completed_since", formatISO8601 since)] + +addTag :: + (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) => + Gid -> + -- | Tag + Gid -> + m () addTag task tag = - void $ post ("/tasks/" <> T.unpack (gidToText task) <> "/addTag") $ ApiData - (object ["tag" .= tag]) - -putCompleted - :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) - => Gid - -> Bool - -> m () + void $ + post ("/tasks/" <> T.unpack (gidToText task) <> "/addTag") $ + ApiData + (object ["tag" .= tag]) + +putCompleted :: + (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) => + Gid -> + Bool -> + m () putCompleted taskId completed = - void $ put ("/tasks/" <> T.unpack (gidToText taskId)) $ ApiData - (object ["completed" .= completed]) + void $ + put ("/tasks/" <> T.unpack (gidToText taskId)) $ + ApiData + (object ["completed" .= completed]) taskUrl :: Task -> Text taskUrl Task {..} = "https://app.asana.com/0/0/" <> gidToText tGid <> "/f" diff --git a/library/Asana/Api/Task/Search.hs b/library/Asana/Api/Task/Search.hs index bde3415..8dad198 100644 --- a/library/Asana/Api/Task/Search.hs +++ b/library/Asana/Api/Task/Search.hs @@ -1,13 +1,13 @@ module Asana.Api.Task.Search - ( SearchWorkspace(..) - , TaskTypeFilter(..) - , searchWorkspace - ) where - -import Asana.Api.Prelude + ( SearchWorkspace (..), + TaskTypeFilter (..), + searchWorkspace, + ) +where import Asana.Api.Gid import Asana.Api.Named +import Asana.Api.Prelude import Asana.Api.Request import Asana.Api.Task import Data.HashMap.Strict (HashMap) @@ -18,40 +18,40 @@ import qualified Data.Text as T data TaskTypeFilter = TasksOnly | SubtasksOnly | AllTaskTypes data SearchWorkspace = SearchWorkspace - { swWorkspaceId :: Gid - , swProjectIds :: [Gid] - , swTaskStatusFilter :: TaskStatusFilter - , swCustomFields :: HashMap Gid Text - , swTaskTypeFilter :: TaskTypeFilter + { swWorkspaceId :: Gid, + swProjectIds :: [Gid], + swTaskStatusFilter :: TaskStatusFilter, + swCustomFields :: HashMap Gid Text, + swTaskTypeFilter :: TaskTypeFilter } -- | Search for tasks within a workspace -searchWorkspace - :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) - => SearchWorkspace - -> m [Named] +searchWorkspace :: + (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env) => + SearchWorkspace -> + m [Named] searchWorkspace SearchWorkspace {..} = getAllParams - (T.unpack $ "/workspaces/" <> gidToText swWorkspaceId <> "/tasks/search") - $ ( "projects.all" - , intercalate "," $ map (T.unpack . gidToText) swProjectIds + (T.unpack $ "/workspaces/" <> gidToText swWorkspaceId <> "/tasks/search") + $ ( "projects.all", + intercalate "," $ map (T.unpack . gidToText) swProjectIds ) - : customFieldParams - <> completed - <> isSubtask - where - customFieldParams = - map - (\(a, b) -> - ("custom_fields." <> T.unpack (gidToText a) <> ".value", T.unpack b) + : customFieldParams + <> completed + <> isSubtask + where + customFieldParams = + map + ( \(a, b) -> + ("custom_fields." <> T.unpack (gidToText a) <> ".value", T.unpack b) ) - $ HashMap.toList swCustomFields + $ HashMap.toList swCustomFields - completed = case swTaskStatusFilter of - AllTasks -> [] - IncompletedTasks -> [("completed", "false")] + completed = case swTaskStatusFilter of + AllTasks -> [] + IncompletedTasks -> [("completed", "false")] - isSubtask = case swTaskTypeFilter of - AllTaskTypes -> [] - TasksOnly -> [("is_subtask", "false")] - SubtasksOnly -> [("is_subtask", "true")] + isSubtask = case swTaskTypeFilter of + AllTaskTypes -> [] + TasksOnly -> [("is_subtask", "false")] + SubtasksOnly -> [("is_subtask", "true")]