asana (empty) → 1.0.0.0
raw patch · 13 files changed
+908/−0 lines, 13 filesdep +aesondep +aeson-casingdep +base
Dependencies added: aeson, aeson-casing, base, bytestring, hashable, http-conduit, iso8601-time, microlens, microlens-mtl, monad-logger, mtl, scientific, text, time, unliftio, unliftio-core, unordered-containers
Files
- CHANGELOG.md +5/−0
- LICENSE +21/−0
- README.md +59/−0
- asana.cabal +74/−0
- library/Asana/Api/CustomField.hs +98/−0
- library/Asana/Api/Gid.hs +28/−0
- library/Asana/Api/Named.hs +19/−0
- library/Asana/Api/Prelude.hs +22/−0
- library/Asana/Api/Project.hs +20/−0
- library/Asana/Api/Request.hs +266/−0
- library/Asana/Api/Task.hs +150/−0
- library/Asana/Api/Task/Search.hs +57/−0
- package.yaml +89/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+## [_Unreleased_](https://github.com/freckle/asana-hs/compare/v1.0.0.0...main)++## [v1.0.0.0](https://github.com/freckle/asana-hs/tree/v1.0.0.0)++First released version.
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2021 Renaissance Learning Inc++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,59 @@+# Asana++Haskell client for the Asana API.++## API Key++1. Visit *Settings > Apps > Developer apps*, create a Personal Access Token++## Simple Usage++For example, to make a quick script to list all incomplete tasks in a project:++```hs+import Asana.Api.Request+import Asana.Api.Task+import Data.Text (pack)+import System.Environment (getEnv)+import Control.Monad.Logger (runStdoutLoggingT)+import Control.Monad.Reader (runReaderT)++main :: IO ()+main = do+ key <- AsanaAccessKey . pack <$> getEnv "ASANA_ACCESS_KEY"++ runStdoutLoggingT $ flip runReaderT key $ do+ let projectId = "..."+ tasks <- getProjectTasks projectId IncompletedTasks+ print tasks+```++## Advanced Usage++This library implements the `Has`-class pattern for use in a `ReaderT`-style+application.++```hs+data App = App+ { -- ...+ , appAsanaAccessKey :: ApiKey+ }++instance HasAsanaAccessKey App where+ asanaAccessKeyL = lens appAsanaAccessKey $ \x y -> x { appAsanaAccessKey = y }++loadApp :: IO App+loadApp = undefined++main :: IO ()+main = do+ app <- loadApp+ runStdoutLoggingT $ runReaderT run app++run :: (MonadLogger m, MonadReader env m, HasAsanaAccessKey env) => m ()+run = undefined+```++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)
+ asana.cabal view
@@ -0,0 +1,74 @@+cabal-version: 1.18+name: asana+version: 1.0.0.0+license: MIT+license-file: LICENSE+maintainer: Freckle Education+homepage: https://github.com/freckle/asana-hs#readme+bug-reports: https://github.com/freckle/asana-hs/issues+synopsis: Asana API Client+description: Please see README.md+category: Utils+build-type: Simple+extra-source-files: package.yaml+extra-doc-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/freckle/asana-hs++library+ exposed-modules:+ Asana.Api.CustomField+ Asana.Api.Gid+ Asana.Api.Named+ Asana.Api.Prelude+ Asana.Api.Project+ Asana.Api.Request+ Asana.Api.Task+ Asana.Api.Task.Search++ hs-source-dirs: library+ other-modules: Paths_asana+ default-language: Haskell2010+ default-extensions:+ BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor+ DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+ FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+ LambdaCase MultiParamTypeClasses NoImplicitPrelude+ NoMonomorphismRestriction OverloadedStrings RankNTypes+ RecordWildCards ScopedTypeVariables StandaloneDeriving+ TypeApplications TypeFamilies++ ghc-options:+ -Weverything -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-monomorphism-restriction -Wno-unsafe -Wno-safe++ build-depends:+ aeson >=1.3.1.1,+ aeson-casing >=0.1.0.5,+ base >=4.11.1.0 && <5,+ bytestring >=0.10.8.2,+ hashable >=1.2.7.0,+ http-conduit >=2.3.2,+ iso8601-time >=0.1.5,+ microlens >=0.4.9.1,+ microlens-mtl >=0.1.11.1,+ monad-logger >=0.3.30,+ mtl >=2.2.2,+ scientific >=0.3.6.2,+ text >=1.2.3.1,+ time >=1.8.0.2,+ unliftio >=0.2.9.0,+ unliftio-core >=0.1.2.0,+ unordered-containers >=0.2.9.0++ if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++ if impl(ghc >=8.10)+ ghc-options:+ -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module
+ library/Asana/Api/CustomField.hs view
@@ -0,0 +1,98 @@+module Asana.Api.CustomField+ ( CustomField(..)+ , CustomFields(..)+ , customEnumId+ , EnumOption(..)+ , putCustomField+ , putCustomFields+ ) where++import Asana.Api.Prelude++import Asana.Api.Gid (Gid, gidToText)+import Asana.Api.Request+import Data.Aeson+import Data.Aeson.Casing (aesonPrefix, snakeCase)+import Data.List (find)+import Data.Scientific (Scientific)+import Data.String (fromString)+import qualified Data.Text as T++data CustomField+ = CustomNumber Gid Text (Maybe Scientific)+ | CustomEnum Gid Text [EnumOption] (Maybe Text)+ | CustomText Gid Text (Maybe Text)+ | Other -- ^ Unexpected types dumped here+ deriving stock (Eq, Generic, Show)++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]+ _ -> []++ -- 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+ }+ deriving stock (Eq, Generic, Show)++instance FromJSON EnumOption where+ parseJSON = genericParseJSON $ aesonPrefix snakeCase++-- | Return a @'CustomField'@s value's Enum id, if possible+--+-- - 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+ option <- find ((== value) . eoName) opts+ pure $ eoGid option+customEnumId _ = Nothing++instance FromJSON CustomField where+ parseJSON = withObject "CustomField" $ \o -> do+ oType <- o .: "type"++ case (oType :: Text) of+ "text" -> CustomText <$> o .: "gid" <*> o .: "name" <*> o .: "text_value"+ "number" ->+ CustomNumber <$> o .: "gid" <*> o .: "name" <*> o .: "number_value"+ "enum" -> do+ value <- o .: "enum_value"+ CustomEnum+ <$> (o .: "gid")+ <*> (o .: "name")+ <*> (o .: "enum_options")+ <*> case value of+ Object vo -> vo .:? "name"+ _ -> pure Nothing+ _ -> pure Other++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 taskId fields =+ void $ put ("/tasks/" <> T.unpack (gidToText taskId)) $ ApiData+ (object ["custom_fields" .= fields])
+ library/Asana/Api/Gid.hs view
@@ -0,0 +1,28 @@+-- | A globally unique identifier+module Asana.Api.Gid+ ( Gid+ , AsanaReference(..)+ , gidToText+ , textToGid+ ) where++import Asana.Api.Prelude++import Data.Aeson+ (FromJSON(..), FromJSONKey, ToJSON, ToJSONKey, genericParseJSON)+import Data.Aeson.Casing (aesonPrefix, snakeCase)+import Data.Hashable (Hashable)++newtype Gid = Gid { gidToText :: Text }+ deriving stock (Eq, Generic, Show)+ deriving newtype (FromJSON, ToJSON, ToJSONKey, FromJSONKey, Hashable)++-- | An object @{ gid: <Gid> }@+newtype AsanaReference = AsanaReference { arGid :: Gid }+ deriving stock (Eq, Generic, Show)++instance FromJSON AsanaReference where+ parseJSON = genericParseJSON $ aesonPrefix snakeCase++textToGid :: Text -> Gid+textToGid = Gid
+ library/Asana/Api/Named.hs view
@@ -0,0 +1,19 @@+-- | Anything with a compact @{ id, name }@ representation+module Asana.Api.Named+ ( Named(..)+ ) where++import Asana.Api.Prelude++import Asana.Api.Gid (Gid)+import Data.Aeson (FromJSON, genericParseJSON, parseJSON)+import Data.Aeson.Casing (aesonPrefix, snakeCase)++data Named = Named+ { nGid :: Gid+ , nName :: Text+ }+ deriving stock (Eq, Generic, Show)++instance FromJSON Named where+ parseJSON = genericParseJSON $ aesonPrefix snakeCase
+ library/Asana/Api/Prelude.hs view
@@ -0,0 +1,22 @@+module Asana.Api.Prelude+ ( module X+ ) where++import Prelude as X++import Control.Arrow as X ((&&&), (***))+import Control.Monad.IO.Unlift as X (MonadUnliftIO)+import Control.Monad.Logger.CallStack as X+import Control.Monad.Reader as X+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)+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)
+ library/Asana/Api/Project.hs view
@@ -0,0 +1,20 @@+module Asana.Api.Project+ ( Project(..)+ ) where++import Asana.Api.Prelude++import Asana.Api.Gid (Gid)+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+ }+ deriving stock (Generic, Show)++instance FromJSON Project where+ parseJSON = genericParseJSON $ aesonPrefix snakeCase
+ library/Asana/Api/Request.hs view
@@ -0,0 +1,266 @@+module Asana.Api.Request+ ( 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+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+ )+import UnliftIO.Concurrent (threadDelay)++newtype AsanaAccessKey = AsanaAccessKey+ { unAsanaAccessKey :: Text+ }++class HasAsanaAccessKey env where+ asanaAccessKeyL :: Lens' env AsanaAccessKey++instance HasAsanaAccessKey AsanaAccessKey where+ asanaAccessKeyL = id++maxRequests :: Int+maxRequests = 50++-- | Type for a single-resource response, containing @{ data: { ... } }@+newtype Single a = Single+ { sData :: a+ }+ deriving newtype (Eq, Show)+ deriving stock Generic++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+ }+ deriving stock (Eq, Generic, Show)++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+ }+ deriving stock (Eq, Generic, Show)++instance FromJSON NextPage where+ parseJSON = genericParseJSON $ aesonPrefix snakeCase++-- | Generic type for un/wrapping an item as @{ data: <item> }@+newtype ApiData a = ApiData+ { adData :: a+ }+ deriving newtype (Show, Eq)+ deriving stock Generic++instance FromJSON a => FromJSON (ApiData a) where+ parseJSON = genericParseJSON $ aesonPrefix snakeCase++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 path = getAllParams path []++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++ 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 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 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+ response <- retry 50 $ httpJSON (addAuthorization key request)+ 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 = httpAction "PUT"++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 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)+ ]++ pure $ getResponseBody response++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 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++ 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++getResponseDelay :: Response a -> Int+getResponseDelay =+ fromMaybe 0+ . readMaybe+ . T.unpack+ . T.decodeUtf8With T.lenientDecode+ . mconcat+ . getResponseHeader "Retry-After"
+ library/Asana/Api/Task.hs view
@@ -0,0 +1,150 @@+module Asana.Api.Task+ ( Task(..)+ , Membership(..)+ , TaskStatusFilter(..)+ , ResourceSubtype(..)+ , PostTask(..)+ , getTask+ , getProjectTasks+ , getProjectTasksCompletedSince+ , postTask+ , putCompleted+ , taskUrl+ , extractNumberField+ , extractEnumField+ ) where++import Asana.Api.Prelude++import Asana.Api.CustomField+import Asana.Api.Gid+import Asana.Api.Named+import Asana.Api.Request+import Data.Aeson+import Data.Aeson.Casing (aesonPrefix, snakeCase)+import Data.HashMap.Strict (HashMap)+import qualified Data.Text as T+import Data.Time (UTCTime, getCurrentTime)+import Data.Time.ISO8601 (formatISO8601)++data Membership = Membership+ { mProject :: Named+ , mSection :: Maybe Named+ }+ deriving stock (Eq, Generic, Show)++instance FromJSON Membership where+ parseJSON = genericParseJSON $ aesonPrefix snakeCase++data ResourceSubtype = DefaultTask | Milestone | Section+ deriving stock (Eq, Generic, Show)++instance FromJSON ResourceSubtype where+ parseJSON =+ 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]+ }+ deriving stock (Eq, Generic, Show)++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 taskId = getSingle $ "/tasks/" <> T.unpack (gidToText taskId)++data PostTask = PostTask+ { ptProjects :: [Gid]+ , ptCustomFields :: HashMap Gid Text+ , ptName :: Text+ , ptNotes :: Text+ , ptParent :: Maybe Gid+ }+ deriving stock Generic++instance FromJSON PostTask where+ parseJSON = genericParseJSON $ aesonPrefix snakeCase++instance ToJSON PostTask where+ toJSON = genericToJSON $ aesonPrefix snakeCase+ toEncoding = genericToEncoding $ aesonPrefix snakeCase++-- | Create a new '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+--+-- 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 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)]++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)]++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])++taskUrl :: Task -> Text+taskUrl Task {..} = "https://app.asana.com/0/0/" <> gidToText tGid <> "/f"++extractNumberField :: Text -> Task -> Maybe CustomField+extractNumberField fieldName Task {..} =+ listToMaybe $ flip mapMaybe (getCustomFields tCustomFields) $ \case+ customField@(CustomNumber _ t _) -> customField <$ guard (t == fieldName)+ _ -> Nothing++extractEnumField :: Text -> Task -> Maybe CustomField+extractEnumField fieldName Task {..} =+ listToMaybe $ flip mapMaybe (getCustomFields tCustomFields) $ \case+ customField@(CustomEnum _ t _ _) ->+ if t == fieldName then Just customField else Nothing+ _ -> Nothing
+ library/Asana/Api/Task/Search.hs view
@@ -0,0 +1,57 @@+module Asana.Api.Task.Search+ ( SearchWorkspace(..)+ , TaskTypeFilter(..)+ , searchWorkspace+ ) where++import Asana.Api.Prelude++import Asana.Api.Gid+import Asana.Api.Named+import Asana.Api.Request+import Asana.Api.Task+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.List (intercalate)+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+ }++-- | Search for tasks within a workspace+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+ )+ : customFieldParams+ <> completed+ <> isSubtask+ where+ customFieldParams =+ map+ (\(a, b) ->+ ("custom_fields." <> T.unpack (gidToText a) <> ".value", T.unpack b)+ )+ $ HashMap.toList swCustomFields++ completed = case swTaskStatusFilter of+ AllTasks -> []+ IncompletedTasks -> [("completed", "false")]++ isSubtask = case swTaskTypeFilter of+ AllTaskTypes -> []+ TasksOnly -> [("is_subtask", "false")]+ SubtasksOnly -> [("is_subtask", "true")]
+ package.yaml view
@@ -0,0 +1,89 @@+name: asana+version: 1.0.0.0+maintainer: Freckle Education+category: Utils+github: freckle/asana-hs+synopsis: Asana API Client+description: Please see README.md++extra-doc-files:+ - README.md+ - CHANGELOG.md++extra-source-files:+ - package.yaml++ghc-options:+ - -Weverything+ - -Wno-missing-exported-signatures # re-enables missing-signatures+ - -Wno-missing-import-lists+ - -Wno-missing-local-signatures+ - -Wno-monomorphism-restriction+ - -Wno-unsafe+ - -Wno-safe++when:+ - condition: "impl(ghc >= 9.2)"+ ghc-options:+ - -Wno-missing-kind-signatures+ - condition: "impl(ghc >= 8.10)"+ ghc-options:+ - -Wno-missing-safe-haskell-mode+ - -Wno-prepositive-qualified-module++dependencies:+ - base < 5++default-extensions:+ - BangPatterns+ - DataKinds+ - DeriveAnyClass+ - DeriveFoldable+ - DeriveFunctor+ - DeriveGeneric+ - DeriveLift+ - DeriveTraversable+ - DerivingStrategies+ - FlexibleContexts+ - FlexibleInstances+ - GADTs+ - GeneralizedNewtypeDeriving+ - LambdaCase+ - MultiParamTypeClasses+ - NoImplicitPrelude+ - NoMonomorphismRestriction+ - OverloadedStrings+ - RankNTypes+ - RecordWildCards+ - ScopedTypeVariables+ - StandaloneDeriving+ - TypeApplications+ - TypeFamilies++library:+ source-dirs: library+ dependencies:+ - aeson+ - aeson-casing+ - bytestring+ - hashable+ - http-conduit+ - iso8601-time+ - microlens+ - microlens-mtl+ - monad-logger+ - mtl+ - scientific+ - text+ - time+ - unliftio+ - unliftio-core+ - unordered-containers+# tests:+# spec:+# main: Spec.hs+# source-dirs: tests+# ghc-options: -threaded -rtsopts "-with-rtsopts=-N"+# dependencies:+# - asana+# - hspec