diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,40 @@ +# Changelog for `TodoistSDK` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Released + +## 0.1.2.1 - 2025-11-17 + +### Added +- Initial release of TodoistSDK +- Tagless final/mtl-style architecture with type class-based operations +- Two interpreters: TodoistIO (real HTTP requests) and Trace (operation recording) +- Complete API coverage for Projects (CRUD, archive/unarchive, collaborators) +- Complete API coverage for Tasks (CRUD, complete/uncomplete, move operations) +- Complete API coverage for Comments (CRUD for projects and tasks) +- Complete API coverage for Sections (CRUD operations) +- Complete API coverage for Labels (CRUD, shared labels) +- Builder pattern for ergonomic request construction +- Cursor-based pagination support with automatic and manual modes +- Comprehensive test suite (unit tests + integration tests) +- MIT license + +### Known Limitations +- REST API v2 is used (v1 is deprecated by Todoist) +- Limited error types (BadRequest, NotFound, Forbidden, Unauthorized, HttpError) +- Some Trace interpreter methods not implemented +- No CI/CD pipeline configured +- Minimal README documentation + +### Dependencies +- base >= 4.7 && < 5 +- text >= 2.1.2 +- transformers >= 0.6.1.1 +- req >= 3.13.4 +- bytestring >= 0.12.2.0 +- aeson >= 1.5 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2025 Sam S. Almahri + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,328 @@ +# TodoistSDK + +[![Hackage](https://img.shields.io/hackage/v/todoist-sdk.svg)](https://hackage.haskell.org/package/todoist-sdk) + +An unofficial Haskell SDK for the [Todoist REST API](https://developer.todoist.com/rest/v2/). Manage projects, tasks, comments, sections, and labels with type-safe, ergonomic Haskell functions. + +## Features + +- **Complete API Coverage**: Projects, Tasks, Comments, Sections, and Labels +- **Type-Safe**: Leverages Haskell's type system to prevent common errors +- **Getter-Only Lenses**: Read-only lenses for convenient field access and composition +- **Ergonomic Builder Pattern**: Easily construct API requests with optional fields +- **Automatic Pagination**: Transparently fetches all pages for list operations +- **Flexible Error Handling**: Operations return `Either TodoistError a` for explicit error handling +- **Testing Support (In Progress)**: Includes Trace interpreter for testing without API calls + +## Installation + +### Using Stack + +Add to your `stack.yaml`: + +```yaml +extra-deps: + - todoist-sdk-0.1.2.1 +``` + +Add to your `package.yaml` or `.cabal` file: + +```yaml +dependencies: + - todoist-sdk +``` + +### Using Cabal + +Add to your `.cabal` file's `build-depends`: + +```cabal +build-depends: + base >=4.7 && <5 + , todoist-sdk +``` + +Then install: + +```bash +cabal update +cabal install todoist-sdk +``` + +## Quick Start + +Get your API token from [Todoist Settings → Integrations → Developer](https://todoist.com/prefs/integrations). + +### Try it in the REPL + +```bash +$ stack repl +``` + +```haskell +>>> import Web.Todoist +>>> let config = newTodoistConfig "your-api-token-here" +>>> result <- todoist config getAllProjects +>>> case result of + Left err -> print err + Right projects -> mapM_ print projects +``` + +### Complete Example + +Create a file `example.hs`: + +```haskell +#!/usr/bin/env stack +-- stack --resolver lts-24.7 script --package todoist-sdk --package text + +{-# LANGUAGE OverloadedStrings #-} + +import Web.Todoist + +main :: IO () +main = do + -- Configure with your API token + let config = newTodoistConfig "your-api-token-here" + + result <- todoist config $ do + -- Create a new project + let newProj = runBuilder (createProjectBuilder "My Haskell Project") + (withDescription "Learning Haskell SDK" <> withViewStyle Board) + project <- addProject newProj + + -- Create a task in the project + let newTask = runBuilder (newTaskBuilder "Read documentation") + (withProjectId (_id project) <> withPriority 2) + task <- createTask newTask + + -- Get all tasks + tasks <- getTasks taskParamBuilder + + pure (project, task, tasks) + + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right (proj, task, tasks) -> do + putStrLn $ "Created project: " ++ show (_name proj) + putStrLn $ "Created task: " ++ show (_content task) + putStrLn $ "Total tasks: " ++ show (length tasks) +``` + +Run it: + +```bash +chmod +x example.hs +./example.hs +``` + +## Common Usage Examples + +### Working with Projects + +```haskell +import Web.Todoist + +let config = newTodoistConfig "your-api-token" + +-- Get all projects +result <- todoist config getAllProjects + +-- Create a project with optional fields +let newProject = runBuilder (createProjectBuilder "Shopping List") + (withColor "blue" <> withViewStyle List <> withIsFavorite True) +project <- todoist config (addProject createProjectBuilder) + +-- Update a project +let update = runBuilder emptyProjectUpdate (withName "Updated Name") +updated <- todoist config (updateProject update projectId) + +-- Delete a project +todoist config (deleteProject projectId) +``` + +### Working with Tasks + +```haskell +-- Create a task with due date +let task = runBuilder (newTaskBuilder "Buy milk") + (withProjectId "project-123" + <> withDueString "tomorrow" + <> withPriority 3 + <> withLabels ["grocery", "urgent"]) +result <- todoist config (createTask task) + +-- Get tasks with filters +let params = TaskParam + { project_id = Just "project-123" + , filter = Nothing + , label_id = Nothing + , cursor = Nothing + , limit = Nothing + } +tasks <- todoist config (getTasks params) + +-- Complete a task +todoist config (closeTask taskId) + +-- Update a task +let update = runBuilder updateTaskBuilder (withContent "Buy 2% milk") +updated <- todoist config (updateTask update taskId) +``` + +### Working with Comments + +```haskell +-- Add a comment to a task +let comment = runBuilder (newCommentBuilder "Don't forget organic!") + (withTaskId "task-456") +result <- todoist config (addComment comment) + +-- Get all comments for a project +let params = CommentParam + { project_id = Just "project-123" + , task_id = Nothing + , cursor = Nothing + , limit = Nothing + , public_key = Nothing + } +comments <- todoist config (getComments params) +``` + +### Working with Sections + +```haskell +-- Create a section +let section = runBuilder (newSection "In Progress" "project-123") mempty +result <- todoist config (addSection section) + +-- Get sections for a project with builder pattern +let params = runBuilder newSectionParam (withProjectId "project-123" <> withLimit 50) +sections <- todoist config (getSections params) +``` + +### Working with Labels + +```haskell +-- Create a label +let label = runBuilder (createLabelBuilder "urgent") mempty +result <- todoist config (addLabel label) + +-- Get all labels +let params = runBuilder labelParamBuilder (withLimit 50) +labels <- todoist config (getLabels params) +``` + +## Working with Lenses + +TodoistSDK provides **getter-only lenses** for all domain types, enabling convenient field access and composition. All lenses are read-only; for mutations, use the builder pattern. + +### Basic Usage + +```haskell +import Web.Todoist +import Web.Todoist.Lens ((^.)) -- Import the getter operator + +-- Get all projects +Right projects <- todoist config getAllProjects + +-- Extract fields using lenses +let firstProject = head projects +let projectName = firstProject ^. name +let projectColor = firstProject ^. color +let isShared = firstProject ^. isShared + +print projectName -- Prints: Name "My Project" +``` + +### Composing Lenses + +Lenses can be composed to access nested fields: + +```haskell +-- Get tasks +Right tasks <- todoist config (getTasks taskParamBuilder) + +-- Access nested fields +let task = head tasks +let maybeDueDate = task ^. taskDue >>= (^. dueDate) +let taskContent = task ^. taskContent + +-- Check if task has a deadline +case task ^. taskDeadline of + Just deadline -> putStrLn $ "Deadline: " ++ show (deadline ^. deadlineDate) + Nothing -> putStrLn "No deadline set" +``` + +### Available Lenses + +All domain types provide lenses for their fields: + +**Project**: `projectId`, `name`, `description`, `order`, `color`, `isCollapsed`, `isShared`, `isFavorite`, `isArchived`, `canAssignTasks`, `viewStyle`, `createdAt`, `updatedAt` + +**Task**: `taskId`, `taskContent`, `taskDescription`, `taskProjectId`, `taskSectionId`, `taskParentId`, `taskLabels`, `taskPriority`, `taskDue`, `taskDeadline`, `taskDuration`, `taskIsCollapsed`, `taskOrder`, `taskAssigneeId`, `taskAssignerId`, `taskCompletedAt`, `taskCreatorId`, `taskCreatedAt`, `taskUpdatedAt` + +**Comment**: `commentId`, `commentContent`, `commentPosterId`, `commentPostedAt`, `commentTaskId`, `commentProjectId`, `commentAttachment` + +**Section**: `sectionId`, `sectionName`, `sectionProjectId`, `sectionIsCollapsed`, `sectionOrder` + +**Label**: `labelId`, `labelName`, `labelColor`, `labelOrder`, `labelIsFavorite` + +**Due**: `dueDate`, `dueString`, `dueLang`, `dueIsRecurring`, `dueTimezone` + +**Deadline**: `deadlineDate`, `deadlineLang` + +**Duration**: `amount`, `unit` + +### Mutation with Builders + +Lenses are **read-only**. For field mutations, use the builder pattern: + +```haskell +-- Reading with lenses +let oldName = project ^. name + +-- Updating with builders (not lenses) +let update = runBuilder updateProjectBuilder (withName "New Name") +Right updatedProject <- todoist config (updateProject update projectId) +``` + +## Error Handling + +All operations return `Either TodoistError a`. The `TodoistError` type includes: + +- `BadRequest` - Invalid request parameters +- `Unauthorized` - Invalid or missing API token +- `Forbidden` - Insufficient permissions +- `NotFound` - Resource doesn't exist +- `HttpError String` - Other HTTP errors + +Example: + +```haskell +result <- todoist config (getProject projectId) +case result of + Left BadRequest -> putStrLn "Invalid project ID" + Left Unauthorized -> putStrLn "Check your API token" + Left NotFound -> putStrLn "Project not found" + Left (HttpError msg) -> putStrLn $ "HTTP error: " ++ msg + Right project -> print project +``` + +## Documentation + +Full API documentation is available on [Hackage](https://hackage.haskell.org/package/todoist-sdk). + +For details on the Todoist REST API, see the [official documentation](https://developer.todoist.com/rest/v2/). + +## License + +This project is licensed under the MIT License - see the [LICENSE](LICENSE) file for details. + +## Contributing + +Contributions are welcome! Please feel free to submit a Pull Request. + +## Acknowledgments + +This library is a labor of love to the Haskell community and to the Todoist app. It is an unofficial SDK and is not affiliated with or endorsed by Doist. 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/integration-test/CommentIntegrationSpec.hs b/integration-test/CommentIntegrationSpec.hs new file mode 100644 --- /dev/null +++ b/integration-test/CommentIntegrationSpec.hs @@ -0,0 +1,366 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module CommentIntegrationSpec (spec) where + +import Helpers + ( assertSucceeds + , buildTestTask + , generateUniqueName + , getTestConfig + , liftTodoist + ) +import Web.Todoist.Domain.Comment + ( CommentCreate + , CommentId (..) + , CommentParam (..) + , Content (..) + , TodoistCommentM (..) + , newCommentBuilder + , updateCommentBuilder + ) +import qualified Web.Todoist.Domain.Comment as C +import qualified Web.Todoist.Domain.Project as P +import Web.Todoist.Domain.Task (NewTask (..), TodoistTaskM (..)) +import Web.Todoist.Domain.Types (ProjectId (..), TaskId (..)) +import Web.Todoist.Internal.Config (TodoistConfig) +import Web.Todoist.Internal.Error (TodoistError) +import Web.Todoist.Lens ((^.)) +import Web.Todoist.Runner (todoist) +import Web.Todoist.Util.Builder (runBuilder, withProjectId, withTaskId) + +import Control.Applicative (pure) +import Control.Exception (bracket) +import Control.Monad (forM_, mapM, void) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Except (ExceptT) +import Data.Bool (Bool (..)) +import Data.Function (($)) +import Data.Functor ((<$>)) +import Data.Int (Int) +import qualified Data.List as L +import Data.Maybe (Maybe (..)) +import Data.Ord ((>=)) +import Data.Semigroup ((<>)) +import Data.Text (Text, pack) +import GHC.Base (mempty) +import System.IO (IO, putStrLn) +import Test.Hspec (Spec, describe, it, pendingWith, runIO, shouldBe, shouldSatisfy) +import Text.Show (show) + +spec :: Spec +spec = do + maybeConfig <- runIO getTestConfig + case maybeConfig of + Nothing -> + it "requires TODOIST_TEST_API_TOKEN" $ + pendingWith "TODOIST_TEST_API_TOKEN not set" + Just config -> do + commentOnProjectLifecycleSpec config + commentOnTaskLifecycleSpec config + updateCommentSpec config + getCommentsSpec config + getSingleCommentSpec config + +commentOnProjectLifecycleSpec :: TodoistConfig -> Spec +commentOnProjectLifecycleSpec config = describe "Comment on project lifecycle (create, get, delete)" $ do + it "creates, retrieves, and deletes a comment on a project" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-CommentProject-Project" + commentContent <- pack <$> generateUniqueName "IntegTest-CommentProject-Comment" + + -- Use withTestProjectComment for automatic cleanup + withTestProjectComment config projectName commentContent $ \projectId commentId -> do + -- Verify we can retrieve the comment + comment <- liftTodoist config (getComment commentId) + + -- Extract comment fields for verification using lenses + let retrievedId = comment ^. C.commentId + retrievedContent = comment ^. C.commentContent + retrievedProjectId = comment ^. C.commentProjectId + retrievedTaskId = comment ^. C.commentTaskId + + -- Verify comment ID matches + liftIO $ retrievedId `shouldBe` commentId + + -- Verify content matches + liftIO $ retrievedContent `shouldBe` Content commentContent + + -- Verify project ID matches and task ID is Nothing + liftIO $ retrievedProjectId `shouldBe` Just projectId + liftIO $ retrievedTaskId `shouldBe` Nothing + + -- Test explicit delete (cleanup will handle if this fails) + liftTodoist config (deleteComment commentId) + +commentOnTaskLifecycleSpec :: TodoistConfig -> Spec +commentOnTaskLifecycleSpec config = describe "Comment on task lifecycle (create, get, delete)" $ do + it "creates, retrieves, and deletes a comment on a task" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-CommentTask-Project" + taskContent <- pack <$> generateUniqueName "IntegTest-CommentTask-Task" + commentContent <- pack <$> generateUniqueName "IntegTest-CommentTask-Comment" + + -- Use withTestTaskComment for automatic cleanup + withTestTaskComment config projectName taskContent commentContent $ \taskId commentId -> do + -- Verify we can retrieve the comment + comment <- liftTodoist config (getComment commentId) + + -- Extract comment fields for verification using lenses + let retrievedId = comment ^. C.commentId + retrievedContent = comment ^. C.commentContent + retrievedProjectId = comment ^. C.commentProjectId + retrievedTaskId = comment ^. C.commentTaskId + + -- Verify comment ID matches + liftIO $ retrievedId `shouldBe` commentId + + -- Verify content matches + liftIO $ retrievedContent `shouldBe` Content commentContent + + -- Verify task ID matches and project ID is Nothing + liftIO $ retrievedTaskId `shouldBe` Just taskId + liftIO $ retrievedProjectId `shouldBe` Nothing + + -- Test explicit delete (cleanup will handle if this fails) + liftTodoist config (deleteComment commentId) + +updateCommentSpec :: TodoistConfig -> Spec +updateCommentSpec config = describe "Update comment" $ do + it "creates a comment, updates its content, verifies changes" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-UpdateComment-Project" + originalContent <- pack <$> generateUniqueName "IntegTest-UpdateComment-Original" + + withTestProjectComment config projectName originalContent $ \_ commentId -> do + -- Verify initial state + comment1 <- liftTodoist config (getComment commentId) + let initialContent = comment1 ^. C.commentContent + liftIO $ initialContent `shouldBe` Content originalContent + + -- Update the comment + let updatedContent = originalContent <> "-Updated" + let commentUpdate = runBuilder (updateCommentBuilder updatedContent) mempty + + updatedComment <- liftTodoist config (updateComment commentUpdate commentId) + + -- Verify the response contains updated value + let responseContent = updatedComment ^. C.commentContent + liftIO $ responseContent `shouldBe` Content updatedContent + + -- Fetch the comment again to verify persistence + comment2 <- liftTodoist config (getComment commentId) + let persistedContent = comment2 ^. C.commentContent + liftIO $ persistedContent `shouldBe` Content updatedContent + +getCommentsSpec :: TodoistConfig -> Spec +getCommentsSpec config = describe "Get multiple comments" $ do + it "creates 3 comments on a project, retrieves them via getComments" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-GetComments-Project" + baseName <- generateUniqueName "IntegTest-GetComments-Comment" + + let commentContent1 = pack $ baseName <> "-Comment1" + let commentContent2 = pack $ baseName <> "-Comment2" + let commentContent3 = pack $ baseName <> "-Comment3" + let commentContents = [commentContent1, commentContent2, commentContent3] + + withTestProjectComments config projectName commentContents $ \projectId commentIds -> do + -- Get all comments for this project + let ProjectId {getProjectId = projIdText} = projectId + let commentParam = + CommentParam + { project_id = Just projIdText + , task_id = Nothing + , cursor = Nothing + , limit = Nothing + , public_key = Nothing + } + + comments <- liftTodoist config (getComments commentParam) + + -- Verify we got at least 3 comments (there might be more from previous tests) + let commentCount = L.length comments + liftIO $ commentCount `shouldSatisfy` (\n -> n >= (3 :: Int)) + + -- Extract comment IDs and contents from results + let commentIdsResult = L.map (^. C.commentId) comments + let commentContentsResult = L.map (^. C.commentContent) comments + + -- Verify all 3 comment IDs are present + let [expectedId1, expectedId2, expectedId3] = commentIds + liftIO $ (expectedId1 `L.elem` commentIdsResult) `shouldBe` True + liftIO $ (expectedId2 `L.elem` commentIdsResult) `shouldBe` True + liftIO $ (expectedId3 `L.elem` commentIdsResult) `shouldBe` True + + -- Verify all 3 comment contents are present + liftIO $ (Content commentContent1 `L.elem` commentContentsResult) `shouldBe` True + liftIO $ (Content commentContent2 `L.elem` commentContentsResult) `shouldBe` True + liftIO $ (Content commentContent3 `L.elem` commentContentsResult) `shouldBe` True + + -- Verify each comment has the correct project_id + forM_ comments $ \comment -> do + let commentProjId = comment ^. C.commentProjectId + commentTaskId = comment ^. C.commentTaskId + case (commentProjId, commentTaskId) of + (Just pid, Nothing) -> liftIO $ pid `shouldBe` ProjectId projIdText + _ -> pure () -- Skip comments that don't match our filter + +getSingleCommentSpec :: TodoistConfig -> Spec +getSingleCommentSpec config = describe "Get single comment by ID" $ do + it "creates a comment and retrieves it by ID" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-GetSingleComment-Project" + commentContent <- pack <$> generateUniqueName "IntegTest-GetSingleComment-Comment" + + withTestProjectComment config projectName commentContent $ \projectId commentId -> do + -- Get the comment by ID + comment <- liftTodoist config (getComment commentId) + + -- Verify the comment + -- Extract comment fields for verification using lenses + let retrievedId = comment ^. C.commentId + retrievedContent = comment ^. C.commentContent + retrievedProjectId = comment ^. C.commentProjectId + + liftIO $ retrievedId `shouldBe` commentId + liftIO $ retrievedContent `shouldBe` Content commentContent + + liftIO $ retrievedProjectId `shouldBe` Just projectId + +{- | Create a test project and comment, run an action with the comment ID, then clean up +Uses bracket to ensure cleanup happens even if the action fails +Comments are deleted before the project +-} +withTestProjectComment :: + TodoistConfig -> + Text -> -- project name + Text -> -- comment content + (ProjectId -> CommentId -> ExceptT TodoistError IO a) -> + IO () +withTestProjectComment config projectName commentContent action = do + let createResources = do + liftIO $ putStrLn $ "Creating test project: " <> show projectName + projectId <- liftTodoist config (P.addProject $ runBuilder (P.createProjectBuilder projectName) mempty) + + liftIO $ putStrLn $ "Creating test comment: " <> show commentContent + let ProjectId {getProjectId = projIdText} = projectId + let commentCreate = buildTestCommentForProject commentContent projIdText + createdComment <- liftTodoist config (addComment commentCreate) + let commentId = createdComment ^. C.commentId + + pure (projectId, commentId) + + let deleteResources (projectId, commentId) = do + liftIO $ putStrLn $ "Cleaning up test comment: " <> show commentContent + void $ todoist config (deleteComment commentId) + + liftIO $ putStrLn $ "Cleaning up test project: " <> show projectName + void $ todoist config (P.deleteProject projectId) + + let runAction (projectId, commentId) = void $ assertSucceeds $ action projectId commentId + + bracket (assertSucceeds createResources) deleteResources runAction + +{- | Create a test project, task, and comment on the task, run an action, then clean up +Uses bracket to ensure cleanup happens even if the action fails +Comments are deleted before tasks, tasks before projects +-} +withTestTaskComment :: + TodoistConfig -> + Text -> -- project name + Text -> -- task content + Text -> -- comment content + (TaskId -> CommentId -> ExceptT TodoistError IO a) -> + IO () +withTestTaskComment config projectName taskContent commentContent action = do + let createResources = do + liftIO $ putStrLn $ "Creating test project: " <> show projectName + projectId <- liftTodoist config (P.addProject $ runBuilder (P.createProjectBuilder projectName) mempty) + + liftIO $ putStrLn $ "Creating test task: " <> show taskContent + let ProjectId {getProjectId = projIdText} = projectId + let taskCreate = buildTestTask taskContent projIdText + newTaskResult <- liftTodoist config (createTask taskCreate) + let NewTask {_id = newTaskIdText} = newTaskResult + let taskId = newTaskIdText + TaskId {getTaskId = taskIdText} = taskId + + liftIO $ putStrLn $ "Creating test comment: " <> show commentContent + let commentCreate = buildTestCommentForTask commentContent taskIdText + createdComment <- liftTodoist config (addComment commentCreate) + let commentId = createdComment ^. C.commentId + + pure (projectId, taskId, commentId) + + let deleteResources (projectId, taskId, commentId) = do + liftIO $ putStrLn $ "Cleaning up test comment: " <> show commentContent + void $ todoist config (deleteComment commentId) + + liftIO $ putStrLn $ "Cleaning up test task: " <> show taskContent + void $ todoist config (deleteTask taskId) + + liftIO $ putStrLn $ "Cleaning up test project: " <> show projectName + void $ todoist config (P.deleteProject projectId) + + let runAction (_, taskId, commentId) = void $ assertSucceeds $ action taskId commentId + + bracket (assertSucceeds createResources) deleteResources runAction + +{- | Create a test project and multiple comments, run an action with their IDs, then clean up +Ensures all comments are deleted before the project is deleted +-} +withTestProjectComments :: + TodoistConfig -> + Text -> -- project name + [Text] -> -- comment contents + (ProjectId -> [CommentId] -> ExceptT TodoistError IO a) -> + IO () +withTestProjectComments config projectName commentContents action = do + let createResources = do + liftIO $ putStrLn $ "Creating test project: " <> show projectName + projectId <- liftTodoist config (P.addProject $ runBuilder (P.createProjectBuilder projectName) mempty) + + liftIO $ putStrLn $ "Creating " <> show (L.length commentContents) <> " test comments" + let ProjectId {getProjectId = projIdText} = projectId + commentIds <- + mapM + ( \content -> do + let commentCreate = buildTestCommentForProject content projIdText + createdComment <- liftTodoist config (addComment commentCreate) + pure $ createdComment ^. C.commentId + ) + commentContents + + pure (projectId, commentIds) + + let deleteResources (projectId, commentIds) = do + liftIO $ putStrLn $ "Cleaning up " <> show (L.length commentIds) <> " test comments" + forM_ commentIds $ \commentId -> + void $ todoist config (deleteComment commentId) + + liftIO $ putStrLn $ "Cleaning up test project: " <> show projectName + void $ todoist config (P.deleteProject projectId) + + let runAction (projectId, commentIds) = void $ assertSucceeds $ action projectId commentIds + + bracket (assertSucceeds createResources) deleteResources runAction + +{- | Build a test comment for a project using the Builder pattern +Creates a CommentCreate with content and project_id for testing +-} +buildTestCommentForProject :: Text -> Text -> CommentCreate +buildTestCommentForProject commentContent projectId = + runBuilder + (newCommentBuilder commentContent) + (withProjectId projectId) + +{- | Build a test comment for a task using the Builder pattern +Creates a CommentCreate with content and task_id for testing +-} +buildTestCommentForTask :: Text -> Text -> CommentCreate +buildTestCommentForTask commentContent taskId = + runBuilder + (newCommentBuilder commentContent) + (withTaskId taskId) diff --git a/integration-test/Helpers.hs b/integration-test/Helpers.hs new file mode 100644 --- /dev/null +++ b/integration-test/Helpers.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +-- | Integration test setup utilities +module Helpers + ( getTestConfig + , generateUniqueName + , withTestConfig + , liftTodoist + , assertSucceeds + , buildTestProject + , buildTestTask + ) where + +import qualified Configuration.Dotenv as Dotenv +import Control.Applicative (pure) +import Control.Exception (SomeException, catch) +import Control.Monad (void) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Data.Bool (Bool (..)) +import Data.Either (Either (..)) +import Data.Function (($), (.)) +import Data.Functor (fmap, (<&>)) +import Data.Int (Int) +import Data.Maybe (Maybe (..)) +import Data.Semigroup ((<>)) +import Data.String (String) +import Data.Text (Text, pack) +import GHC.Err (error) +import System.Environment (lookupEnv) +import System.IO (IO, putStrLn) +import System.Random (randomRIO) +import Test.Hspec (shouldBe) +import Text.Show (Show, show) +import Web.Todoist.Domain.Project (ProjectCreate, createProjectBuilder) +import Web.Todoist.Domain.Task (TaskCreate, newTaskBuilder) +import Web.Todoist.Domain.Types (ViewStyle (..)) +import Web.Todoist.Internal.Config (TodoistConfig) +import Web.Todoist.Internal.Error (TodoistError) +import Web.Todoist.Runner (MonadTodoist, newTodoistConfig, todoist) +import Web.Todoist.Util.Builder + ( runBuilder + , withDescription + , withProjectId + , withViewStyle + ) + +-- | Load .env file, ignoring errors if file doesn't exist +loadEnvFile :: IO () +loadEnvFile = catch (void (Dotenv.loadFile Dotenv.defaultConfig)) handler + where + handler :: SomeException -> IO () + handler _ = pure () + +{- | Get TodoistConfig from TODOIST_TEST_API_TOKEN environment variable +Returns Nothing if the environment variable is not set +Attempts to load .env file first +-} +getTestConfig :: IO (Maybe TodoistConfig) +getTestConfig = do + loadEnvFile + lookupEnv "TODOIST_TEST_API_TOKEN" <&> fmap (newTodoistConfig . pack) + +{- | Generate a unique name by appending a random number to a prefix +Example: generateUniqueName "TestProject" -> "TestProject-847392" +-} +generateUniqueName :: String -> IO String +generateUniqueName prefix = randomRIO (100 :: Int, 999 :: Int) <&> ((prefix <> "-") <>) . show + +{- | Execute an action with test config, or skip if config is not available +Useful for conditional test execution based on environment variable presence +-} +withTestConfig :: (TodoistConfig -> IO ()) -> IO () +withTestConfig action = do + maybeConfig <- getTestConfig + case maybeConfig of + Nothing -> putStrLn "Skipping: TODOIST_TEST_API_TOKEN not set" + Just config -> action config + +{- | Lift a Todoist operation into ExceptT +Makes it easier to chain API calls in do-notation +-} +liftTodoist :: TodoistConfig -> (forall m. (MonadTodoist m) => m a) -> ExceptT TodoistError IO a +liftTodoist config operation = ExceptT $ todoist config operation + +{- | Unwrap an ExceptT computation and fail the test if it resulted in an error +Prints the error message and fails the test using Hspec's shouldBe +-} +assertSucceeds :: (Show e) => ExceptT e IO a -> IO a +assertSucceeds action = do + result <- runExceptT action + case result of + Left err -> do + putStrLn $ "Test failed with error: " <> show err + False `shouldBe` True + error "unreachable: test should have failed" + Right val -> pure val + +{- | Build a test project with all fields set using the Builder pattern +Creates a ProjectCreate with all possible fields populated for testing +-} +buildTestProject :: Text -> ProjectCreate +buildTestProject projectName = + runBuilder + (createProjectBuilder projectName) + (withDescription "Test project description for integration testing" <> withViewStyle Board) + +{- | Build a test task with basic fields set using the Builder pattern +Creates a TaskCreate with content, description, and project_id for testing +-} +buildTestTask :: Text -> Text -> TaskCreate +buildTestTask taskContent projectId = + runBuilder + (newTaskBuilder taskContent) + (withDescription "Test task description for integration testing" <> withProjectId projectId) diff --git a/integration-test/LabelIntegrationSpec.hs b/integration-test/LabelIntegrationSpec.hs new file mode 100644 --- /dev/null +++ b/integration-test/LabelIntegrationSpec.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE DisambiguateRecordFields #-} + +module LabelIntegrationSpec (spec) where + +import Control.Applicative (Applicative (pure), (<$>)) +import Control.Exception (bracket) +import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Except (ExceptT) +import Data.Bool (Bool (..)) +import Data.Foldable (traverse_) +import Data.Function (($), (.)) +import Data.Functor (Functor (..)) +import Data.List (elem, length) +import Data.Maybe (Maybe (..)) +import Data.Monoid (Monoid (..), (<>)) +import Data.Ord ((>=)) +import Data.Text (Text, pack) +import Data.Traversable (traverse) +import Helpers + ( assertSucceeds + , generateUniqueName + , getTestConfig + , liftTodoist + ) +import System.IO (IO, putStrLn) +import Test.Hspec (Spec, describe, it, pendingWith, runIO, shouldBe, shouldSatisfy) +import Text.Show (show) +import Web.Todoist.Domain.Label + ( Label (..) + , LabelId (..) + , LabelParam (..) + , SharedLabelParam (..) + , mkSharedLabelRemove + , mkSharedLabelRename + , addLabel + , deleteLabel + , getLabel + , getLabels + , getSharedLabels + , createLabelBuilder + , removeSharedLabels + , renameSharedLabels + , updateLabel + , updateLabelBuilder + ) +import Web.Todoist.Domain.Types (Color (..), IsFavorite (..), Name (..)) +import Web.Todoist.Internal.Error (TodoistError) +import Web.Todoist.Runner (todoist) +import Web.Todoist.Runner.IO (TodoistConfig) +import Web.Todoist.Util.Builder (runBuilder, withName, withColor, withIsFavorite) + +spec :: Spec +spec = do + maybeConfig <- runIO getTestConfig + case maybeConfig of + Nothing -> + it "requires TODOIST_TEST_API_TOKEN" $ + pendingWith "TODOIST_TEST_API_TOKEN not set" + Just config -> do + labelLifecycleSpec config + getLabelsSpec config + updateLabelSpec config + sharedLabelsSpec config + +labelLifecycleSpec :: TodoistConfig -> Spec +labelLifecycleSpec config = + describe "Label CRUD lifecycle" $ do + it "creates, retrieves, and deletes a label" $ do + labelName <- pack <$> generateUniqueName "IntegTest-Label" + + withTestLabel config labelName $ \labelId -> do + -- Get label and verify fields + label <- liftTodoist config (getLabel labelId) + let Label {_name = labName} = label + liftIO $ labName `shouldBe` Name labelName + + -- Delete label + liftTodoist config (deleteLabel labelId) + + -- Verify deletion by checking label is not in active labels list + let params = LabelParam {cursor = Nothing, limit = Nothing} + labels <- liftTodoist config (getLabels params) + let labelIds = fmap (\(Label {_id = lid}) -> lid) labels + liftIO $ labelId `elem` labelIds `shouldBe` False + +getLabelsSpec :: TodoistConfig -> Spec +getLabelsSpec config = + describe "Get multiple labels" $ do + it "creates multiple labels and retrieves them with getLabels" $ do + -- Create 3 labels + label1Name <- pack <$> generateUniqueName "Label1" + label2Name <- pack <$> generateUniqueName "Label2" + label3Name <- pack <$> generateUniqueName "Label3" + + withMultipleTestLabels config [label1Name, label2Name, label3Name] $ \_ -> do + -- Get labels + let params = LabelParam {cursor = Nothing, limit = Nothing} + labels <- liftTodoist config (getLabels params) + + -- Verify count and names + let labelNames = fmap (\(Label {_name = n}) -> n) labels + liftIO $ Name label1Name `elem` labelNames `shouldBe` True + liftIO $ Name label2Name `elem` labelNames `shouldBe` True + liftIO $ Name label3Name `elem` labelNames `shouldBe` True + +updateLabelSpec :: TodoistConfig -> Spec +updateLabelSpec config = + describe "Update label" $ do + it "updates a label name and color" $ do + labelName <- pack <$> generateUniqueName "IntegTest-Update-Label" + + withTestLabel config labelName $ \labelId -> do + -- Update label name and favorite status + let newName = labelName <> "-Updated" + update = runBuilder updateLabelBuilder (withName newName <> withColor "berry_red" <> withIsFavorite True) + updatedLabel <- liftTodoist config (updateLabel update labelId) + + -- Verify update + let Label {_name = updatedName, _id = updatedId, _color = updatedColor, _is_favorite = updatedFav} = updatedLabel + liftIO $ updatedName `shouldBe` Name newName + liftIO $ updatedId `shouldBe` labelId + liftIO $ updatedColor `shouldBe` Color "berry_red" + liftIO $ updatedFav `shouldBe` IsFavorite True + +sharedLabelsSpec :: TodoistConfig -> Spec +sharedLabelsSpec config = + describe "Shared labels operations" $ do + it "gets shared labels" $ do + let params = SharedLabelParam {omit_personal = Nothing, cursor = Nothing, limit = Just 10} + sharedLabels <- assertSucceeds $ liftTodoist config (getSharedLabels params) + -- Just verify we can call the endpoint without errors + -- Actual content depends on user's account + liftIO $ length sharedLabels `shouldSatisfy` (>= 0) + + it "renames and removes shared labels" $ do + -- Create a label to work with + labelName <- pack <$> generateUniqueName "SharedTest" + + withTestLabel config labelName $ \_ -> do + -- Rename shared label + let renameReq = mkSharedLabelRename labelName (labelName <> "-Renamed") + liftTodoist config (renameSharedLabels renameReq) + + -- Remove shared label + let removeReq = mkSharedLabelRemove (labelName <> "-Renamed") + liftTodoist config (removeSharedLabels removeReq) + + -- If we got here without errors, operations succeeded + pure () + +-- | Bracket helper for creating test label +withTestLabel :: TodoistConfig -> Text -> (LabelId -> ExceptT TodoistError IO a) -> IO () +withTestLabel config labelName action = do + let createLabel = do + liftIO $ putStrLn $ "Creating test label: " <> show labelName + liftTodoist config (addLabel $ runBuilder (createLabelBuilder labelName) mempty) + + let deleteLabel' labelId = do + liftIO $ putStrLn $ "Cleaning up test label: " <> show labelName + void $ todoist config (deleteLabel labelId) + + let runAction labelId = void $ assertSucceeds $ action labelId + + bracket (assertSucceeds createLabel) deleteLabel' runAction + +-- | Bracket helper for creating multiple test labels +withMultipleTestLabels :: + TodoistConfig -> [Text] -> ([LabelId] -> ExceptT TodoistError IO a) -> IO () +withMultipleTestLabels config labelNames action = do + let createLabels = do + liftIO $ putStrLn $ "Creating test labels: " <> show labelNames + liftTodoist config $ traverse (\name -> addLabel $ runBuilder (createLabelBuilder name) mempty) labelNames + + let deleteLabels' labelIds = do + liftIO $ putStrLn $ "Cleaning up test labels: " <> show labelNames + traverse_ (void . todoist config . deleteLabel) labelIds + + let runAction labelIds = void $ assertSucceeds $ action labelIds + + bracket (assertSucceeds createLabels) deleteLabels' runAction diff --git a/integration-test/ProjectIntegrationSpec.hs b/integration-test/ProjectIntegrationSpec.hs new file mode 100644 --- /dev/null +++ b/integration-test/ProjectIntegrationSpec.hs @@ -0,0 +1,409 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module ProjectIntegrationSpec (spec) where + +import Helpers (assertSucceeds, buildTestProject, generateUniqueName, getTestConfig, liftTodoist) + +import Web.Todoist.Domain.Project + ( ProjectCreate + , TodoistProjectM (..) + , createProjectBuilder + , updateProjectBuilder + ) +import qualified Web.Todoist.Domain.Project as P +import Web.Todoist.Domain.Types + ( Description (..) + , IsFavorite (..) + , Name (..) + , ProjectId (..) + , getName + ) +import Web.Todoist.Internal.Config (TodoistConfig) +import Web.Todoist.Internal.Error (TodoistError) +import Web.Todoist.Internal.Types + ( Action (..) + , ProjectPermissions (..) + , RoleActions (..) + ) +import Web.Todoist.Lens ((^.)) +import Web.Todoist.Runner (todoist) +import Web.Todoist.Util.Builder (runBuilder, withDescription, withName, withIsFavorite) + +import Control.Exception (bracket) +import Control.Monad (forM_, mapM, mapM_, void) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Except (ExceptT) +import Data.Bool (Bool (..)) +import Data.Either (Either (..)) +import Data.Eq ((==)) +import Data.Function (const, ($), (.)) +import Data.Functor ((<$>)) +import Data.Int (Int) +import qualified Data.List as L +import Data.Maybe (Maybe (..)) +import Data.Semigroup ((<>)) +import Data.Text (Text, isInfixOf, pack) +import qualified Data.Text as T +import System.IO (IO, putStrLn) +import Test.Hspec (Spec, describe, it, pendingWith, runIO, shouldBe, shouldSatisfy) +import Text.Show (show) + +import GHC.Base (mempty, undefined) + +spec :: Spec +spec = do + maybeConfig <- runIO getTestConfig + case maybeConfig of + Nothing -> + it "requires TODOIST_TEST_API_TOKEN" $ + pendingWith "TODOIST_TEST_API_TOKEN not set" + Just config -> do + projectLifecycleSpec config + archiveUnarchiveSpec config + getAllProjectsSpec config + getProjectCollaboratorsSpec config + getProjectPermissionsSpec config + updateProjectSpec config + +projectLifecycleSpec :: TodoistConfig -> Spec +projectLifecycleSpec config = describe "Project lifecycle (create, get, delete)" $ do + it "creates, retrieves, and deletes a project with all fields set" $ do + -- Generate unique project name + createProjectBuilderName <- pack <$> generateUniqueName "IntegTest-ProjectLifecycle" + + -- Build a complete project with all fields using the Builder pattern + let testProject = buildTestProject createProjectBuilderName + + -- Extract expected values from testProject for verification + let expectedName = testProject ^. P.projectCreateName + expectedDescription = testProject ^. P.projectCreateDescription + expectedViewStyle = testProject ^. P.projectCreateViewStyle + expectedIsFavorite = testProject ^. P.projectCreateIsFavorite + + -- Use withTestProjectCreate to handle creation and cleanup + withTestProjectCreate config testProject $ \projectId -> do + -- Get the project by ID and verify all fields + project <- liftTodoist config (getProject projectId) + let projId = project ^. P.projectId + projName = project ^. P.name + projDescription = project ^. P.description + projViewStyle = project ^. P.viewStyle + projIsFavorite = project ^. P.isFavorite + + -- Verify the project details match expected values + liftIO $ projId `shouldBe` projectId + liftIO $ projName `shouldBe` expectedName + + -- Verify description field matches testProject + liftIO $ Just projDescription `shouldBe` expectedDescription + + -- Verify view_style field matches testProject + liftIO $ Just projViewStyle `shouldBe` expectedViewStyle + + -- Verify is_favorite field matches testProject + liftIO $ projIsFavorite `shouldBe` expectedIsFavorite + + -- Test deletion within the action + liftTodoist config (deleteProject projectId) + + -- Verify project no longer exists (should get an error) + verifyResult <- liftIO $ todoist config (getProject projectId) + liftIO $ verifyResult `shouldSatisfy` (\case Left _ -> True; _ -> False) + +archiveUnarchiveSpec :: TodoistConfig -> Spec +archiveUnarchiveSpec config = describe "Project archive/unarchive lifecycle" $ do + it "archives and unarchives a project successfully" $ do + -- Generate unique project name + projectName <- pack <$> generateUniqueName "IntegTest-ArchiveUnarchive" + + -- Use withTestProject to handle creation and cleanup + withTestProject config projectName $ \projectId -> do + -- Archive the project + archivedId <- liftTodoist config (archiveProject projectId) + + -- Verify returned ID matches + let ProjectId {getProjectId = pidId} = projectId + let ProjectId {getProjectId = archivedPidId} = archivedId + liftIO $ archivedPidId `shouldBe` pidId + + -- Verify project is archived by getting it + P.Project {_is_archived = isArchived} <- liftTodoist config (getProject projectId) + liftIO $ isArchived `shouldBe` P.IsArchived True + + -- Unarchive the project + unarchivedId <- liftTodoist config (unarchiveProject projectId) + + -- Verify returned ID matches + let ProjectId {getProjectId = unarchivedPidId} = unarchivedId + liftIO $ unarchivedPidId `shouldBe` pidId + + -- Verify project is no longer archived + P.Project {_is_archived = isStillArchived} <- liftTodoist config (getProject projectId) + liftIO $ isStillArchived `shouldBe` P.IsArchived False + +getAllProjectsSpec :: TodoistConfig -> Spec +getAllProjectsSpec config = describe "Get all projects" $ do + it + "creates 3 projects, retrieves them via getAllProjects, validates count and properties, then deletes them" + $ do + -- Generate unique base name for this test run + baseName <- generateUniqueName "IntegTest-GetAll" + + -- Create 3 projects with unique names + let projectName1 = pack $ baseName <> "-Project1" + let projectName2 = pack $ baseName <> "-Project2" + let projectName3 = pack $ baseName <> "-Project3" + let projectNames = [projectName1, projectName2, projectName3] + + -- Use withTestProjects to handle creation and cleanup + withTestProjects config projectNames $ \case + [projectId1, projectId2, projectId3] -> do + -- Get all projects + allProjects <- liftTodoist config getAllProjects + + -- Filter to only our test projects + let testPrefix = pack baseName + let ourProjects = L.filter (\(P.Project {_name = n}) -> testPrefix `isInfixOf` getName n) allProjects + + -- Verify we got exactly 3 projects + let projectCount = L.length ourProjects + liftIO $ projectCount `shouldBe` (3 :: Int) + + -- Extract the project names from our filtered list + let projectNamesResult = L.map (\(P.Project {_name = n}) -> n) ourProjects + + -- Verify all 3 project names are present + liftIO $ (Name projectName1 `L.elem` projectNamesResult) `shouldBe` True + liftIO $ (Name projectName2 `L.elem` projectNamesResult) `shouldBe` True + liftIO $ (Name projectName3 `L.elem` projectNamesResult) `shouldBe` True + + -- Verify each project has the expected properties + let project1Maybe = L.find (\(P.Project {_name = n}) -> n == Name projectName1) ourProjects + let project2Maybe = L.find (\(P.Project {_name = n}) -> n == Name projectName2) ourProjects + let project3Maybe = L.find (\(P.Project {_name = n}) -> n == Name projectName3) ourProjects + + -- Verify all projects were found + case (project1Maybe, project2Maybe, project3Maybe) of + ( Just (P.Project {_id = id1, _name = name1}) + , Just (P.Project {_id = id2, _name = name2}) + , Just (P.Project {_id = id3, _name = name3}) + ) -> do + -- Verify project IDs match + liftIO $ id1 `shouldBe` projectId1 + liftIO $ id2 `shouldBe` projectId2 + liftIO $ id3 `shouldBe` projectId3 + + -- Verify project names match + liftIO $ name1 `shouldBe` Name projectName1 + liftIO $ name2 `shouldBe` Name projectName2 + liftIO $ name3 `shouldBe` Name projectName3 + _ -> do + liftIO $ putStrLn "Failed to find all 3 projects in the filtered list" + liftIO $ False `shouldBe` True + _ -> undefined -- impossible case + +getProjectCollaboratorsSpec :: TodoistConfig -> Spec +getProjectCollaboratorsSpec config = describe "Get project collaborators" $ do + it "retrieves collaborators for a project and validates their structure" $ do + -- Generate unique project name + projectName <- pack <$> generateUniqueName "IntegTest-Collaborators" + + -- Use withTestProject to handle creation and cleanup + withTestProject config projectName $ \projectId -> do + -- Get project collaborators + collaborators <- liftTodoist config (getProjectCollaborators projectId) + + -- Validate structure of each collaborator if any exist + -- Note: Personal projects may have no collaborators, which is valid + let validateCollaborator (P.Collaborator {_id = collabId, _name = collabName, _email = collabEmail}) = do + -- Verify _id is non-empty + T.null collabId `shouldBe` False + + -- Verify _name is non-empty + T.null (getName collabName) `shouldBe` False + + -- Verify _email is non-empty and contains '@' + T.null collabEmail `shouldBe` False + ("@" `T.isInfixOf` collabEmail) `shouldBe` True + + -- Validate each collaborator's structure + liftIO $ mapM_ validateCollaborator collaborators + +getProjectPermissionsSpec :: TodoistConfig -> Spec +getProjectPermissionsSpec config = describe "Get project permissions" $ do + it "creates 3 projects, retrieves permissions, validates structure, then deletes projects" $ do + -- Generate unique base name for this test run + baseName <- generateUniqueName "IntegTest-Permissions" + + -- Create 3 project names + let projectName1 = pack $ baseName <> "-Project1" + let projectName2 = pack $ baseName <> "-Project2" + let projectName3 = pack $ baseName <> "-Project3" + let projectNames = [projectName1, projectName2, projectName3] + + -- Use withTestProjects to handle creation and cleanup + withTestProjects config projectNames $ \projectIds -> do + -- Verify we created 3 projects + liftIO $ L.length projectIds `shouldBe` (3 :: Int) + + -- Get permissions (static endpoint - doesn't use project IDs) + permissions <- liftTodoist config getProjectPermissions + + -- Validate structure exists + liftIO $ do + -- Both arrays should be present (may be empty but must exist) + p_project_collaborator_actions permissions `shouldSatisfy` const True + p_workspace_collaborator_actions permissions `shouldSatisfy` const True + + -- If there are role actions, validate their structure + let validateRoleAction (RoleActions {p_name = roleName, p_actions = actions}) = do + -- p_name is type-safe CollaboratorRole - if it parsed, it's valid + -- Don't check for specific role, just that it parsed correctly + roleName `shouldSatisfy` const True + -- Validate each action has a non-empty name + forM_ actions $ \(Action {p_name = actionName}) -> do + T.null actionName `shouldBe` False + + -- Validate all roles in both arrays + mapM_ validateRoleAction (p_project_collaborator_actions permissions) + mapM_ validateRoleAction (p_workspace_collaborator_actions permissions) + +-- Projects will be automatically deleted by withTestProjects bracket + +updateProjectSpec :: TodoistConfig -> Spec +updateProjectSpec config = describe "Update project" $ do + it "creates a project, updates its properties, verifies changes, then deletes it" $ do + -- Generate unique project name + originalName <- pack <$> generateUniqueName "IntegTest-Update-Original" + + -- Define description values + let originalDescription = "Original description" + let updatedDescription = "Updated description" + + -- Create initial project with specific properties + let initialProject = runBuilder (createProjectBuilder originalName) (withDescription originalDescription) + + withTestProjectCreate config initialProject $ \projectId -> do + -- Verify initial state + project1 <- liftTodoist config (getProject projectId) + liftIO $ do + let P.Project {P._name = proj1Name, P._description = proj1Desc, P._is_favorite = proj1Fav} = project1 + proj1Name `shouldBe` Name originalName + proj1Desc `shouldBe` Description originalDescription + proj1Fav `shouldBe` IsFavorite False -- default from createProjectBuilder + + -- Update the project (change name, description, and favorite status) + let updatedName = originalName <> "-Updated" + let projectUpdate = runBuilder updateProjectBuilder (withName updatedName <> withDescription updatedDescription <> withIsFavorite True) + + updatedProject <- liftTodoist config (updateProject projectUpdate projectId) + + -- Verify the response contains updated values + liftIO $ do + let P.Project + { P._name = updatedProjName + , P._description = updatedProjDesc + , P._is_favorite = updatedProjFav + } = updatedProject + updatedProjName `shouldBe` Name updatedName + updatedProjDesc `shouldBe` Description updatedDescription + updatedProjFav `shouldBe` IsFavorite True + + -- Fetch the project again to double-check persistence + project2 <- liftTodoist config (getProject projectId) + liftIO $ do + let P.Project + { P._name = proj2Name + , P._description = proj2Desc + , P._is_favorite = proj2Fav + , P._view_style = proj2ViewStyle + } = project2 + let P.Project {P._view_style = proj1ViewStyle} = project1 + proj2Name `shouldBe` Name updatedName + proj2Desc `shouldBe` Description updatedDescription + proj2Fav `shouldBe` IsFavorite True + -- Verify unchanged fields remain unchanged + proj2ViewStyle `shouldBe` proj1ViewStyle + + it "supports partial updates (only updating specific fields)" $ do + -- Generate unique project name + projectName <- pack <$> generateUniqueName "IntegTest-PartialUpdate" + + -- Define initial description + let initialDescription = "Initial description" + + -- Create initial project + let initialProject = runBuilder (createProjectBuilder projectName) (withDescription initialDescription) + + withTestProjectCreate config initialProject $ \projectId -> do + -- Get initial state + project1 <- liftTodoist config (getProject projectId) + let P.Project {P._description = originalDescription} = project1 + + -- Partial update: only change is_favorite + let partialUpdate = runBuilder updateProjectBuilder (withIsFavorite True) + + updatedProject <- liftTodoist config (updateProject partialUpdate projectId) + + -- Verify only is_favorite changed + liftIO $ do + let P.Project {P._is_favorite = updatedFav, P._name = updatedName, P._description = updatedDesc} = updatedProject + updatedFav `shouldBe` IsFavorite True + -- Other fields should remain unchanged + updatedName `shouldBe` Name projectName + updatedDesc `shouldBe` originalDescription + +{- | Create a test project from a ProjectCreate, run an action with its ID, then delete it +Uses bracket to ensure cleanup happens even if the action fails +The action runs in ExceptT for clean error handling +-} +withTestProjectCreate :: + TodoistConfig -> ProjectCreate -> (ProjectId -> ExceptT TodoistError IO a) -> IO () +withTestProjectCreate config projectCreate action = do + let createProject = do + liftTodoist config (addProject projectCreate) + + let deleteProject' projectId = do + void $ todoist config (Web.Todoist.Domain.Project.deleteProject projectId) + + let runAction projectId = void $ assertSucceeds $ action projectId + + bracket (assertSucceeds createProject) deleteProject' runAction + +{- | Create a test project, run an action with its ID, then delete it +Uses bracket to ensure cleanup happens even if the action fails +The action runs in ExceptT for clean error handling +-} +withTestProject :: TodoistConfig -> Text -> (ProjectId -> ExceptT TodoistError IO a) -> IO () +withTestProject config projectName action = do + let createProject = do + liftIO $ putStrLn $ "Creating test project: " <> show projectName + liftTodoist config (addProject $ runBuilder (createProjectBuilder projectName) mempty) + + let deleteProject' projectId = do + liftIO $ putStrLn $ "Cleaning up test project: " <> show projectName + void $ todoist config (Web.Todoist.Domain.Project.deleteProject projectId) + + let runAction projectId = void $ assertSucceeds $ action projectId + + bracket (assertSucceeds createProject) deleteProject' runAction + +{- | Create multiple test projects, run an action with their IDs, then delete all +Uses bracket to ensure cleanup of all projects even if the action fails +The action runs in ExceptT for clean error handling +-} +withTestProjects :: TodoistConfig -> [Text] -> ([ProjectId] -> ExceptT TodoistError IO a) -> IO () +withTestProjects config projectNames action = do + let createProjects = do + liftIO $ putStrLn $ "Creating " <> show (L.length projectNames) <> " test projects" + mapM (\name -> liftTodoist config (addProject $ runBuilder (createProjectBuilder name) mempty)) projectNames + + let deleteProjects projectIds = do + liftIO $ putStrLn $ "Cleaning up " <> show (L.length projectIds) <> " test projects" + mapM_ (todoist config . Web.Todoist.Domain.Project.deleteProject) projectIds + + let runAction projectIds = void $ assertSucceeds $ action projectIds + + bracket (assertSucceeds createProjects) deleteProjects runAction diff --git a/integration-test/SectionIntegrationSpec.hs b/integration-test/SectionIntegrationSpec.hs new file mode 100644 --- /dev/null +++ b/integration-test/SectionIntegrationSpec.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE DisambiguateRecordFields #-} + +module SectionIntegrationSpec (spec) where + +import Control.Applicative (Applicative (pure), (<$>)) +import Control.Exception (bracket) +import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Except (ExceptT) +import Data.Bool (Bool (..)) +import Data.Function (($)) +import Data.Functor (Functor (..)) +import Data.List (elem) +import Data.Maybe (Maybe (..)) +import Data.Monoid (Monoid (..), (<>)) +import Data.Text (Text, pack) +import Helpers + ( assertSucceeds + , generateUniqueName + , getTestConfig + , liftTodoist + ) +import System.IO (IO, putStrLn) +import Test.Hspec (Spec, describe, it, pendingWith, runIO, shouldBe) +import Text.Show (show) +import qualified Web.Todoist.Domain.Project as P +import Web.Todoist.Domain.Section + ( Section (..) + , SectionId (..) + , SectionParam (..) + , addSection + , deleteSection + , getSection + , getSections + , newSectionBuilder + , updateSection + , updateSectionBuilder + ) +import Web.Todoist.Domain.Types (Name (..), ProjectId (..)) +import Web.Todoist.Internal.Error (TodoistError) +import Web.Todoist.Runner (todoist) +import Web.Todoist.Runner.IO (TodoistConfig) +import Web.Todoist.Util.Builder (runBuilder, withName) + +spec :: Spec +spec = do + maybeConfig <- runIO getTestConfig + case maybeConfig of + Nothing -> + it "requires TODOIST_TEST_API_TOKEN" $ + pendingWith "TODOIST_TEST_API_TOKEN not set" + Just config -> do + sectionLifecycleSpec config + getSectionsSpec config + updateSectionSpec config + +sectionLifecycleSpec :: TodoistConfig -> Spec +sectionLifecycleSpec config = + describe "Section CRUD lifecycle" $ do + it "creates, retrieves, and deletes a section" $ do + projectName <- pack <$> generateUniqueName "IntegTest-Section-Project" + sectionName <- pack <$> generateUniqueName "IntegTest-Section" + + withTestProjectAndSection config projectName sectionName $ \projectId sectionId -> do + -- Get section and verify fields + section <- liftTodoist config (getSection sectionId) + let Section {_name = secName, _project_id = secProjectId} = section + liftIO $ secName `shouldBe` Name sectionName + liftIO $ secProjectId `shouldBe` projectId + + -- Delete section + liftTodoist config (deleteSection sectionId) + + -- Verify deletion by checking section is not in active sections list + let params = SectionParam {project_id = Just projectId, cursor = Nothing, limit = Nothing} + sections <- liftTodoist config (getSections params) + let sectionIds = fmap (\(Section {_id = sid}) -> sid) sections + liftIO $ sectionId `elem` sectionIds `shouldBe` False + +getSectionsSpec :: TodoistConfig -> Spec +getSectionsSpec config = + describe "Get multiple sections" $ do + it "creates multiple sections and retrieves them with getSections" $ do + projectName <- pack <$> generateUniqueName "IntegTest-GetSections-Project" + + withTestProject config projectName $ \projectId -> do + let ProjectId {getProjectId = projId} = projectId + + -- Create 3 sections + section1Name <- pack <$> liftIO (generateUniqueName "Section1") + section2Name <- pack <$> liftIO (generateUniqueName "Section2") + section3Name <- pack <$> liftIO (generateUniqueName "Section3") + + sectionId1 <- liftTodoist config (addSection $ runBuilder (newSectionBuilder section1Name projId) mempty) + sectionId2 <- liftTodoist config (addSection $ runBuilder (newSectionBuilder section2Name projId) mempty) + sectionId3 <- liftTodoist config (addSection $ runBuilder (newSectionBuilder section3Name projId) mempty) + + -- Get sections for project + let params = SectionParam {project_id = Just projectId, cursor = Nothing, limit = Nothing} + sections <- liftTodoist config (getSections params) + + -- Verify count and names + let sectionNames = fmap (\(Section {_name = n}) -> n) sections + liftIO $ Name section1Name `elem` sectionNames `shouldBe` True + liftIO $ Name section2Name `elem` sectionNames `shouldBe` True + liftIO $ Name section3Name `elem` sectionNames `shouldBe` True + + -- Cleanup + liftTodoist config (deleteSection sectionId1) + liftTodoist config (deleteSection sectionId2) + liftTodoist config (deleteSection sectionId3) + +updateSectionSpec :: TodoistConfig -> Spec +updateSectionSpec config = + describe "Update section" $ do + it "updates a section name" $ do + projectName <- pack <$> generateUniqueName "IntegTest-Update-Project" + sectionName <- pack <$> generateUniqueName "IntegTest-Update-Section" + + withTestProjectAndSection config projectName sectionName $ \_ sectionId -> do + -- Update section name + let newName = sectionName <> "-Updated" + update = runBuilder updateSectionBuilder (withName newName) + updatedSection <- liftTodoist config (updateSection update sectionId) + + -- Verify update + let Section {_name = updatedName, _id = updatedId} = updatedSection + liftIO $ updatedName `shouldBe` Name newName + liftIO $ updatedId `shouldBe` sectionId + +-- | Bracket helper for creating test project +withTestProject :: TodoistConfig -> Text -> (ProjectId -> ExceptT TodoistError IO a) -> IO () +withTestProject config projectName action = do + let createProject = do + liftIO $ putStrLn $ "Creating test project: " <> show projectName + liftTodoist config (P.addProject $ runBuilder (P.createProjectBuilder projectName) mempty) + + let deleteProject' projectId = do + liftIO $ putStrLn $ "Cleaning up test project: " <> show projectName + void $ todoist config (P.deleteProject projectId) + + let runAction projectId = void $ assertSucceeds $ action projectId + + bracket (assertSucceeds createProject) deleteProject' runAction + +-- | Bracket helper for creating test project and section +withTestProjectAndSection :: + TodoistConfig -> + Text -> + Text -> + (ProjectId -> SectionId -> ExceptT TodoistError IO a) -> + IO () +withTestProjectAndSection config projectName sectionName action = do + let createResources = do + liftIO $ + putStrLn $ + "Creating test project and section: " <> show projectName <> " / " <> show sectionName + projectId <- liftTodoist config (P.addProject $ runBuilder (P.createProjectBuilder projectName) mempty) + let ProjectId {getProjectId = projId} = projectId + sectionCreate = runBuilder (newSectionBuilder sectionName projId) mempty + sectionId <- liftTodoist config (addSection sectionCreate) + pure (projectId, sectionId) + + let deleteResources (projectId, sectionId) = do + liftIO $ + putStrLn $ + "Cleaning up test section and project: " <> show sectionName <> " / " <> show projectName + void $ todoist config (deleteSection sectionId) + void $ todoist config (P.deleteProject projectId) + + let runAction (projectId, sectionId) = void $ assertSucceeds $ action projectId sectionId + + bracket (assertSucceeds createResources) deleteResources runAction diff --git a/integration-test/Spec.hs b/integration-test/Spec.hs new file mode 100644 --- /dev/null +++ b/integration-test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/integration-test/TaskIntegrationSpec.hs b/integration-test/TaskIntegrationSpec.hs new file mode 100644 --- /dev/null +++ b/integration-test/TaskIntegrationSpec.hs @@ -0,0 +1,474 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module TaskIntegrationSpec (spec) where + +import Helpers + ( assertSucceeds + , buildTestTask + , generateUniqueName + , getTestConfig + , liftTodoist + ) + +import qualified Web.Todoist.Domain.Project as P +import Web.Todoist.Domain.Task + ( NewTask (..) + , Task (..) + , TodoistTaskM (..) + , moveTaskBuilder + , updateTaskBuilder + , completedTasksQueryParamBuilder + , filterTaskBuilder + ) +import qualified Web.Todoist.Domain.Task as T +import Web.Todoist.Domain.Types (Content (..), Description (..), ProjectId (..), TaskId (..)) +import Web.Todoist.Internal.Config (TodoistConfig) +import Web.Todoist.Internal.Error (TodoistError) +import Web.Todoist.Runner (todoist) +import Web.Todoist.Util.Builder + ( runBuilder + , withContent + , withDescription + , withDueDate + , withPriority + , withProjectId + ) + +import Control.Applicative (pure) +import Control.Exception (bracket) +import Control.Monad (forM_, mapM, void) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Except (ExceptT) +import Data.Bool (Bool (..)) +import Data.Either (Either (..)) +import Data.Function (($)) +import Data.Functor ((<$>)) +import Data.Int (Int) +import qualified Data.List as L +import Data.Maybe (Maybe (..)) +import Data.Semigroup ((<>)) +import Data.Text (Text, pack) +import System.IO (IO, putStrLn) +import Test.Hspec (Spec, describe, it, pendingWith, runIO, shouldBe, shouldSatisfy) +import Text.Show (show) + +import GHC.Base (mempty) + +spec :: Spec +spec = do + maybeConfig <- runIO getTestConfig + case maybeConfig of + Nothing -> + it "requires TODOIST_TEST_API_TOKEN" $ + pendingWith "TODOIST_TEST_API_TOKEN not set" + Just config -> do + taskLifecycleSpec config + taskCompletionSpec config + getTasksSpec config + updateTaskSpec config + taskFilterSpec config + moveTaskSpec config + +taskLifecycleSpec :: TodoistConfig -> Spec +taskLifecycleSpec config = describe "Task lifecycle (create, get, delete)" $ do + it "creates, retrieves, and deletes a task with all fields verified" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-TaskLifecycle-Project" + taskContent <- pack <$> generateUniqueName "IntegTest-TaskLifecycle-Task" + + -- Use withTestTask for automatic cleanup + withTestTask config projectName taskContent $ \projectId taskId -> do + -- Verify we can retrieve the task + task <- liftTodoist config (getTask taskId) + + -- Extract task fields for verification + let Task + { _id = retrievedId + , _content = retrievedContent + , _description = retrievedDescription + , _project_id = retrievedProjectId + } = task + + -- Verify task ID matches + liftIO $ retrievedId `shouldBe` taskId + + -- Verify content matches + liftIO $ retrievedContent `shouldBe` Content taskContent + + -- Verify description was set + liftIO $ retrievedDescription `shouldBe` Description "Test task description for integration testing" + + -- Verify project ID matches + liftIO $ retrievedProjectId `shouldBe` projectId + + -- Test explicit delete (cleanup will handle if this fails) + liftTodoist config (deleteTask taskId) + +taskCompletionSpec :: TodoistConfig -> Spec +taskCompletionSpec config = describe "Task completion/uncompletion lifecycle" $ do + it "marks a task as complete then reopens it" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-TaskCompletion-Project" + taskContent <- pack <$> generateUniqueName "IntegTest-TaskCompletion-Task" + + withTestTask config projectName taskContent $ \_ taskId -> do + -- Verify task starts as not completed + task1 <- liftTodoist config (getTask taskId) + let Task {_completed_at = initialCompletedAt} = task1 + liftIO $ initialCompletedAt `shouldBe` Nothing + + -- Close the task + liftTodoist config (closeTask taskId) + + -- Try to get the task after closing + getResult <- liftIO $ todoist config (getTask taskId) + case getResult of + Right closedTask -> do + -- If we can still get it, verify it's marked as completed + let Task {_completed_at = completedAt} = closedTask + liftIO $ completedAt `shouldSatisfy` (\case Just _ -> True; Nothing -> False) + Left _ -> do + -- If we can't get it, that's also acceptable (API behavior) + liftIO $ putStrLn "Task not retrievable after closing (expected API behavior)" + + -- Unclose the task + liftTodoist config (uncloseTask taskId) + + -- Verify task is now uncompleted + task2 <- liftTodoist config (getTask taskId) + let Task {_completed_at = finalCompletedAt} = task2 + liftIO $ finalCompletedAt `shouldBe` Nothing + +getTasksSpec :: TodoistConfig -> Spec +getTasksSpec config = describe "Get multiple tasks" $ do + it "creates 3 tasks, retrieves them via getTasks, validates count and properties" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-GetTasks-Project" + baseName <- generateUniqueName "IntegTest-GetTasks-Task" + + let taskContent1 = pack $ baseName <> "-Task1" + let taskContent2 = pack $ baseName <> "-Task2" + let taskContent3 = pack $ baseName <> "-Task3" + let taskContents = [taskContent1, taskContent2, taskContent3] + + withTestTasks config projectName taskContents $ \projectId taskIds -> do + -- Get all tasks for this project + let ProjectId {getProjectId = projIdText} = projectId + let taskParam = runBuilder T.taskParamBuilder (withProjectId projIdText) + + tasks <- liftTodoist config (getTasks taskParam) + + -- Verify we got exactly 3 tasks + let taskCount = L.length tasks + liftIO $ taskCount `shouldBe` (3 :: Int) + + -- Extract task IDs and contents from results + let taskIdsResult = L.map (\(Task {_id = tid}) -> tid) tasks + let taskContentsResult = L.map (\(Task {_content = content}) -> content) tasks + + -- Verify all 3 task IDs are present + let [expectedId1, expectedId2, expectedId3] = taskIds + liftIO $ (expectedId1 `L.elem` taskIdsResult) `shouldBe` True + liftIO $ (expectedId2 `L.elem` taskIdsResult) `shouldBe` True + liftIO $ (expectedId3 `L.elem` taskIdsResult) `shouldBe` True + + -- Verify all 3 task contents are present + liftIO $ (Content taskContent1 `L.elem` taskContentsResult) `shouldBe` True + liftIO $ (Content taskContent2 `L.elem` taskContentsResult) `shouldBe` True + liftIO $ (Content taskContent3 `L.elem` taskContentsResult) `shouldBe` True + + -- Verify each task has the correct project_id + forM_ tasks $ \(Task {_project_id = taskProjId}) -> do + liftIO $ taskProjId `shouldBe` projectId + +updateTaskSpec :: TodoistConfig -> Spec +updateTaskSpec config = describe "Update task" $ do + it "creates a task, updates its properties, verifies changes" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-UpdateTask-Project" + originalContent <- pack <$> generateUniqueName "IntegTest-UpdateTask-Original" + + withTestTask config projectName originalContent $ \projectId taskId -> do + -- Verify initial state + task1 <- liftTodoist config (getTask taskId) + let Task + { _content = initialContent + , _description = initialDescription + , _priority = initialPriority + } = task1 + + liftIO $ initialContent `shouldBe` Content originalContent + liftIO $ initialDescription `shouldBe` Description "Test task description for integration testing" + liftIO $ initialPriority `shouldBe` 1 -- default priority + + -- Update the task + let updatedContent = originalContent <> "-Updated" + let updatedDescription = "Updated task description" + let updatedPriority = 3 + + let taskPatch = + runBuilder + updateTaskBuilder + ( withContent updatedContent + <> withDescription updatedDescription + <> withPriority updatedPriority + ) + + updatedNewTask <- liftTodoist config (updateTask taskPatch taskId) + + -- Verify the response contains updated values + let NewTask + { _content = responseContent + , _description = responseDescription + , _priority = responsePriority + } = updatedNewTask + + liftIO $ responseContent `shouldBe` Content updatedContent + liftIO $ responseDescription `shouldBe` Description updatedDescription + liftIO $ responsePriority `shouldBe` updatedPriority + + -- Fetch the task again to verify persistence + task2 <- liftTodoist config (getTask taskId) + let Task + { _content = persistedContent + , _description = persistedDescription + , _priority = persistedPriority + , _project_id = persistedProjectId + } = task2 + + liftIO $ persistedContent `shouldBe` Content updatedContent + liftIO $ persistedDescription `shouldBe` Description updatedDescription + liftIO $ persistedPriority `shouldBe` updatedPriority + + -- Verify project_id unchanged + liftIO $ persistedProjectId `shouldBe` projectId + + it "supports partial updates (only updating specific fields)" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-PartialUpdate-Project" + taskContent <- pack <$> generateUniqueName "IntegTest-PartialUpdate-Task" + + withTestTask config projectName taskContent $ \_ taskId -> do + -- Get initial state + task1 <- liftTodoist config (getTask taskId) + let Task + { _content = originalContent + , _description = originalDescription + } = task1 + + -- Partial update: only change priority + let taskPatch = + runBuilder + updateTaskBuilder + (withPriority 4) + + _ <- liftTodoist config (updateTask taskPatch taskId) + + -- Verify only priority changed + task2 <- liftTodoist config (getTask taskId) + let Task + { _content = finalContent + , _description = finalDescription + , _priority = finalPriority + } = task2 + + liftIO $ finalPriority `shouldBe` 4 + -- Other fields should remain unchanged + liftIO $ finalContent `shouldBe` originalContent + liftIO $ finalDescription `shouldBe` originalDescription + +taskFilterSpec :: TodoistConfig -> Spec +taskFilterSpec config = describe "Task filtering" $ do + it "searches tasks using text filter" $ do + -- Generate unique names with distinctive search term + projectName <- pack <$> generateUniqueName "IntegTest-Filter-Project" + searchTerm <- generateUniqueName "UNIQUE_SEARCHABLE_TERM" + let taskContent = pack $ "Task with " <> searchTerm + + withTestTask config projectName taskContent $ \_ taskId -> do + -- Search for tasks containing our unique term + -- Use search: prefix for text search in Todoist filter syntax + let filter = runBuilder (filterTaskBuilder (pack $ "search: " <> searchTerm)) mempty + taskIds <- liftTodoist config (getTasksByFilter filter) + + -- Verify our task is in the results + let TaskId {getTaskId = expectedIdText} = taskId + let taskIdTexts = L.map (\(TaskId {getTaskId = tid}) -> tid) taskIds + liftIO $ (expectedIdText `L.elem` taskIdTexts) `shouldBe` True + + it "retrieves completed tasks by due date range" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-CompletedDue-Project" + taskContent <- pack <$> generateUniqueName "IntegTest-CompletedDue-Task" + + withTestTask config projectName taskContent $ \projectId taskId -> do + -- Set a due date on the task first + let taskPatch = + runBuilder + updateTaskBuilder + (withDueDate "2025-11-03") + + _ <- liftTodoist config (updateTask taskPatch taskId) + + -- Complete the task + liftTodoist config (closeTask taskId) + + -- Query for completed tasks by due date + -- Use a wide range to ensure we catch our task + let ProjectId {getProjectId = projIdText} = projectId + let queryParamWithProject = + runBuilder + (completedTasksQueryParamBuilder "2025-11-01" "2025-11-30") + (withProjectId projIdText) + + completedTaskIds <- liftTodoist config (getCompletedTasksByDueDate queryParamWithProject) + + -- Verify our task is in the results + let TaskId {getTaskId = expectedIdText} = taskId + let taskIdTexts = L.map (\(TaskId {getTaskId = tid}) -> tid) completedTaskIds + liftIO $ (expectedIdText `L.elem` taskIdTexts) `shouldBe` True + + -- Unclose for cleanup + liftTodoist config (uncloseTask taskId) + + it "retrieves completed tasks by completion date range" $ do + -- Generate unique names + projectName <- pack <$> generateUniqueName "IntegTest-CompletedDate-Project" + taskContent <- pack <$> generateUniqueName "IntegTest-CompletedDate-Task" + + withTestTask config projectName taskContent $ \projectId taskId -> do + -- Complete the task + liftTodoist config (closeTask taskId) + + -- Query for completed tasks by completion date (today) + -- Use a wide range to ensure we catch our task + let ProjectId {getProjectId = projIdText} = projectId + let queryParamWithProject = + runBuilder + (completedTasksQueryParamBuilder "2025-11-01" "2025-11-30") + (withProjectId projIdText) + + completedTaskIds <- liftTodoist config (getCompletedTasksByCompletionDate queryParamWithProject) + + -- Verify our task is in the results + let TaskId {getTaskId = expectedIdText} = taskId + let taskIdTexts = L.map (\(TaskId {getTaskId = tid}) -> tid) completedTaskIds + liftIO $ (expectedIdText `L.elem` taskIdTexts) `shouldBe` True + + -- Unclose for cleanup + liftTodoist config (uncloseTask taskId) + +moveTaskSpec :: TodoistConfig -> Spec +moveTaskSpec config = describe "Move task between projects" $ do + it "creates two projects, moves a task from one to the other" $ do + -- Generate unique names + project1Name <- pack <$> generateUniqueName "IntegTest-MoveTask-Project1" + project2Name <- pack <$> generateUniqueName "IntegTest-MoveTask-Project2" + taskContent <- pack <$> generateUniqueName "IntegTest-MoveTask-Task" + + -- Create project 1 with task + withTestTask config project1Name taskContent $ \project1Id taskId -> do + -- Create project 2 + project2Id <- liftTodoist config (P.addProject $ runBuilder (P.createProjectBuilder project2Name) mempty) + + -- Verify task is in project 1 + task1 <- liftTodoist config (getTask taskId) + let Task {_project_id = originalProjectId} = task1 + liftIO $ originalProjectId `shouldBe` project1Id + + -- Move task to project 2 + let ProjectId {getProjectId = project2IdText} = project2Id + let moveTaskData = runBuilder moveTaskBuilder (withProjectId project2IdText) + + movedTaskId <- liftTodoist config (moveTask moveTaskData taskId) + + -- Verify returned task ID matches + let TaskId {getTaskId = expectedIdText} = taskId + let TaskId {getTaskId = movedIdText} = movedTaskId + liftIO $ movedIdText `shouldBe` expectedIdText + + -- Verify task is now in project 2 + task2 <- liftTodoist config (getTask taskId) + let Task {_project_id = createProjectBuilderId} = task2 + liftIO $ createProjectBuilderId `shouldBe` project2Id + + -- Clean up project 2 (task will be deleted by withTestTask cleanup) + liftTodoist config (P.deleteProject project2Id) + +{- | Create a test project and task, run an action with the task ID, then clean up +Uses bracket to ensure cleanup happens even if the action fails +Tasks are deleted before the project +-} +withTestTask :: + TodoistConfig -> + Text -> -- project name + Text -> -- task content + (ProjectId -> TaskId -> ExceptT TodoistError IO a) -> + IO () +withTestTask config projectName taskContent action = do + let createResources = do + liftIO $ putStrLn $ "Creating test project: " <> show projectName + projectId <- liftTodoist config (P.addProject $ runBuilder (P.createProjectBuilder projectName) mempty) + + liftIO $ putStrLn $ "Creating test task: " <> show taskContent + let ProjectId {getProjectId = projIdText} = projectId + let taskCreate = buildTestTask taskContent projIdText + newTaskResult <- liftTodoist config (createTask taskCreate) + let NewTask {_id = newTaskIdText} = newTaskResult + let taskId = newTaskIdText + + pure (projectId, taskId) + + let deleteResources (projectId, taskId) = do + liftIO $ putStrLn $ "Cleaning up test task: " <> show taskContent + void $ todoist config (deleteTask taskId) + + liftIO $ putStrLn $ "Cleaning up test project: " <> show projectName + void $ todoist config (P.deleteProject projectId) + + let runAction (projectId, taskId) = void $ assertSucceeds $ action projectId taskId + + bracket (assertSucceeds createResources) deleteResources runAction + +{- | Create a test project and multiple tasks, run an action with their IDs, then clean up +Ensures all tasks are deleted before the project is deleted +-} +withTestTasks :: + TodoistConfig -> + Text -> -- project name + [Text] -> -- task contents + (ProjectId -> [TaskId] -> ExceptT TodoistError IO a) -> + IO () +withTestTasks config projectName taskContents action = do + let createResources = do + liftIO $ putStrLn $ "Creating test project: " <> show projectName + projectId <- liftTodoist config (P.addProject $ runBuilder (P.createProjectBuilder projectName) mempty) + + liftIO $ putStrLn $ "Creating " <> show (L.length taskContents) <> " test tasks" + let ProjectId {getProjectId = projIdText} = projectId + taskIds <- + mapM + ( \content -> do + let taskCreate = buildTestTask content projIdText + newTaskResult <- liftTodoist config (createTask taskCreate) + let NewTask {_id = newTaskIdText} = newTaskResult + pure newTaskIdText + ) + taskContents + + pure (projectId, taskIds) + + let deleteResources (projectId, taskIds) = do + liftIO $ putStrLn $ "Cleaning up " <> show (L.length taskIds) <> " test tasks" + forM_ taskIds $ \taskId -> + void $ todoist config (deleteTask taskId) + + liftIO $ putStrLn $ "Cleaning up test project: " <> show projectName + void $ todoist config (P.deleteProject projectId) + + let runAction (projectId, taskIds) = void $ assertSucceeds $ action projectId taskIds + + bracket (assertSucceeds createResources) deleteResources runAction diff --git a/src/Web/Todoist.hs b/src/Web/Todoist.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist.hs @@ -0,0 +1,257 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +{- | +Module : Web.Todoist +Description : Main entry point for the Todoist SDK +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +This module provides a convenient single import for using the Todoist SDK. +It re-exports the most commonly used types and functions. + += Quick Start + +> import Web.Todoist +> +> main :: IO () +> main = do +> let config = newTodoistConfig "your-api-token" +> result <- todoist config $ do +> projects <- getAllProjects +> pure projects +> case result of +> Left err -> print err +> Right projects -> print projects +-} +module Web.Todoist + ( -- * Running Operations + todoist + , newTodoistConfig + , runTodoistWith + , MonadTodoist + + -- * Core Types + , TodoistConfig (..) + , TodoistIO (..) + , TodoistError (..) + + -- * Domain Type Classes + , TodoistProjectM (..) + , TodoistTaskM (..) + , TodoistCommentM (..) + , TodoistSectionM (..) + , TodoistLabelM (..) + + -- * Project Types + , Project + , ProjectCreate + , ProjectUpdate + , Collaborator + , PaginationParam (..) + , createProjectBuilder + , updateProjectBuilder + , paginationParamBuilder + , IsShared (..) + , IsArchived (..) + , CanAssignTasks (..) + + -- * Task Types + , Task (..) + , TaskParam (..) + , NewTask (..) + , MoveTask + , taskParamBuilder + + -- * Comment Types + , Comment (..) + , CommentId (..) + , CommentCreate + , CommentUpdate + , CommentParam (..) + , newCommentBuilder + , updateCommentBuilder + , commentParamBuilder + + -- * Section Types + , Section (..) + , SectionId (..) + , SectionCreate + , SectionUpdate + , SectionParam (..) + , newSectionBuilder + , updateSectionBuilder + , sectionParamBuilder + + -- * Label Types + , Label (..) + , LabelId (..) + , LabelCreate + , LabelUpdate + , LabelParam (..) + , SharedLabelParam (..) + , SharedLabelRename + , SharedLabelRemove + , createLabelBuilder + , updateLabelBuilder + , labelParamBuilder + , sharedLabelParamBuilder + , mkSharedLabelRename + , mkSharedLabelRemove + + -- * Common Domain Types + , ProjectId (..) + , TaskId (..) + , Name (..) + , Description (..) + , Color (..) + , IsFavorite (..) + , ViewStyle (..) + , Order (..) + , Content (..) + , ParentId (..) + + -- * Builder Pattern + , Builder + , Initial + , runBuilder + , seed + , withName + , withDescription + , withIsFavorite + , withViewStyle + , withParentId + , withProjectId + , withSectionId + , withContent + , withColor + , withPriority + , withDueString + , withDueDate + , withDueDatetime + , withDueLang + , withAssigneeId + , withLabels + , withWorkspaceId + , withOrder + , withTaskId + ) where + +import Web.Todoist.Runner + ( MonadTodoist + , newTodoistConfig + , runTodoistWith + , todoist + ) + +import Web.Todoist.Runner.IO + ( TodoistConfig (..) + , TodoistIO (..) + ) + +import Web.Todoist.Internal.Error (TodoistError (..)) + +import Web.Todoist.Domain.Project + ( CanAssignTasks (..) + , Collaborator + , IsArchived (..) + , IsShared (..) + , PaginationParam (..) + , Project + , ProjectCreate + , ProjectUpdate + , TodoistProjectM (..) + , updateProjectBuilder + , paginationParamBuilder + , createProjectBuilder + ) + +import Web.Todoist.Domain.Task + ( MoveTask + , NewTask (..) + , Task (..) + , TaskParam (..) + , TodoistTaskM (..) + , taskParamBuilder + ) + +import Web.Todoist.Domain.Comment + ( Comment (..) + , CommentCreate + , CommentId (..) + , CommentParam (..) + , CommentUpdate + , TodoistCommentM (..) + , newCommentBuilder + , commentParamBuilder + , updateCommentBuilder + ) + +import Web.Todoist.Domain.Section + ( Section (..) + , SectionCreate + , SectionId (..) + , SectionParam (..) + , SectionUpdate + , TodoistSectionM (..) + , updateSectionBuilder + , newSectionBuilder + , sectionParamBuilder + ) + +import Web.Todoist.Domain.Label + ( Label (..) + , LabelCreate + , LabelId (..) + , LabelParam (..) + , LabelUpdate + , SharedLabelParam (..) + , SharedLabelRemove + , SharedLabelRename + , TodoistLabelM (..) + , updateLabelBuilder + , createLabelBuilder + , labelParamBuilder + , sharedLabelParamBuilder + , mkSharedLabelRename + , mkSharedLabelRemove + ) + +import Web.Todoist.Domain.Types + ( Color (..) + , Content (..) + , Description (..) + , IsFavorite (..) + , Name (..) + , Order (..) + , ParentId (..) + , ProjectId (..) + , TaskId (..) + , ViewStyle (..) + ) + +import Web.Todoist.Util.Builder + ( Builder + , Initial + , runBuilder + , seed + , withAssigneeId + , withColor + , withContent + , withDescription + , withDueDate + , withDueDatetime + , withDueLang + , withDueString + , withIsFavorite + , withLabels + , withName + , withOrder + , withParentId + , withPriority + , withProjectId + , withSectionId + , withTaskId + , withViewStyle + , withWorkspaceId + ) diff --git a/src/Web/Todoist/Domain/Comment.hs b/src/Web/Todoist/Domain/Comment.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Domain/Comment.hs @@ -0,0 +1,330 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} + +{- | +Module : Web.Todoist.Domain.Comment +Description : Comment API types and operations for Todoist REST API +Copyright : (c) 2025 Sam Saud Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +This module provides types and operations for working with Todoist comments. Comments can be +attached to either projects or tasks, and support attachments, user notifications, and pagination. + += Usage Example + +@ +import Web.Todoist.Domain.Comment +import Web.Todoist.Builder +import Web.Todoist.Runner (todoist, newTodoistConfig) + +main :: IO () +main = do + let config = newTodoistConfig "your-api-token" + + -- Create a comment on a project + let projectComment = runBuilder (newCommentBuilder "Great project!") + (withProjectId "project-id-123") + result <- todoist config (addComment projectComment) + + -- Create a comment on a task + let taskComment = runBuilder (newCommentBuilder "Don't forget this!") + (withTaskId "task-id-456") + result <- todoist config (addComment taskComment) + + -- Get all comments for a project with builder pattern + let params = runBuilder commentParamBuilder (withProjectId "project-id-123" <> withLimit 50) + comments <- todoist config (getComments params) + + -- Update a comment + let update = runBuilder (updateCommentBuilder "Updated text!") mempty + updatedComment <- todoist config (updateComment update commentId) +@ + +For more details on the Todoist Comments API, see: + +-} +module Web.Todoist.Domain.Comment + ( -- * Types + CommentId (..) + , Content (..) + , Comment (..) + , CommentCreate + , CommentUpdate + , CommentParam (..) + + -- * Constructors + , newCommentBuilder + , updateCommentBuilder + , commentParamBuilder + + -- * Type Class + , TodoistCommentM (..) + + -- * Lenses + , commentId + , commentContent + , commentPosterId + , commentPostedAt + , commentTaskId + , commentProjectId + , commentAttachment + ) where + +import Web.Todoist.Internal.Types (FileAttachment, Params) +import Web.Todoist.Util.Builder + ( HasAttachment (..) + , HasContent (..) + , HasCursor (..) + , HasLimit (..) + , HasProjectId (..) + , HasPublicKey (..) + , HasTaskId (..) + , HasUidsToNotify (..) + , Initial + , seed + ) +import Web.Todoist.Util.QueryParam (QueryParam (..)) + +import Control.Applicative ((<$>)) +import Control.Monad (Monad) +import Data.Aeson + ( FromJSON (..) + , ToJSON (..) + , Value + , genericToJSON + , object + ) +import qualified Data.Aeson as Aeson +import Data.Aeson.Types (Parser) +import Data.Bool (Bool (False, True), not) +import Data.Eq (Eq) +import Data.Foldable (null) +import Data.Function (($), (.)) +import Data.Int (Int) +import Data.List (filter) +import qualified Data.List as L +import Data.Maybe (Maybe (Just, Nothing), maybe) +import Data.Monoid ((<>)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Tuple as L +import GHC.Generics (Generic) +import Lens.Micro (to) +import Text.Show (Show (..)) +import Web.Todoist.Domain.Types (Attachment, Content (..), ProjectId (..), TaskId (..), Uid) +import Web.Todoist.Lens (Getter) + +-- | Newtype wrapper for Comment ID +newtype CommentId = CommentId {getCommentId :: Text} + deriving (Show, Eq, Generic) + +instance ToJSON CommentId where + toJSON :: CommentId -> Value + toJSON (CommentId txt) = toJSON txt + +instance FromJSON CommentId where + parseJSON :: Value -> Parser CommentId + parseJSON v = CommentId <$> parseJSON v + +-- | Comment domain type +data Comment = Comment + { _id :: CommentId + , _content :: Content + , _poster_id :: Maybe Uid + , _posted_at :: Maybe Uid + , _task_id :: Maybe TaskId + , _project_id :: Maybe ProjectId + , _attachment :: Maybe FileAttachment + } + deriving (Show, Eq, Generic) + +-- | Lenses for Comment +commentId :: Getter Comment CommentId +commentId = to (\(Comment {_id = x}) -> x) +{-# INLINE commentId #-} + +commentContent :: Getter Comment Content +commentContent = to (\(Comment {_content = x}) -> x) +{-# INLINE commentContent #-} + +commentPosterId :: Getter Comment (Maybe Uid) +commentPosterId = to (\(Comment {_poster_id = x}) -> x) +{-# INLINE commentPosterId #-} + +commentPostedAt :: Getter Comment (Maybe Uid) +commentPostedAt = to (\(Comment {_posted_at = x}) -> x) +{-# INLINE commentPostedAt #-} + +commentTaskId :: Getter Comment (Maybe TaskId) +commentTaskId = to (\(Comment {_task_id = x}) -> x) +{-# INLINE commentTaskId #-} + +commentProjectId :: Getter Comment (Maybe ProjectId) +commentProjectId = to (\(Comment {_project_id = x}) -> x) +{-# INLINE commentProjectId #-} + +commentAttachment :: Getter Comment (Maybe FileAttachment) +commentAttachment = to (\(Comment {_attachment = x}) -> x) +{-# INLINE commentAttachment #-} + +-- | Request body for creating a comment +data CommentCreate = CommentCreate + { _content :: Content + , _project_id :: Maybe ProjectId + , _task_id :: Maybe TaskId + , _attachment :: Maybe Attachment + , _uids_to_notify :: [Int] + } + deriving (Show, Eq, Generic) + +-- Custom ToJSON instance to omit empty lists and Nothing fields +instance ToJSON CommentCreate where + toJSON :: CommentCreate -> Value + toJSON CommentCreate {..} = + object $ + filter + (not . isEmptyValue . L.snd) + [ ("content", Aeson.toJSON _content) + , ("project_id", maybe Aeson.Null (Aeson.toJSON . getProjectId) _project_id) + , ("task_id", maybe Aeson.Null (Aeson.toJSON . getTaskId) _task_id) + , ("attachment", Aeson.toJSON _attachment) + , ("uids_to_notify", Aeson.toJSON _uids_to_notify) + ] + where + isEmptyValue :: Value -> Bool + isEmptyValue Aeson.Null = True + isEmptyValue (Aeson.Array v) = null v + isEmptyValue _ = False + +-- | Request body for updating a comment +newtype CommentUpdate = CommentUpdate + { _content :: Maybe Text + } + deriving (Show, Eq, Generic) + +instance ToJSON CommentUpdate where + toJSON :: CommentUpdate -> Value + toJSON = + genericToJSON + Aeson.defaultOptions {Aeson.fieldLabelModifier = L.drop 1, Aeson.omitNothingFields = True} + +-- | Query parameters for fetching comments +data CommentParam = CommentParam + { project_id :: Maybe Text + , task_id :: Maybe Text + , cursor :: Maybe Text + , limit :: Maybe Int + , public_key :: Maybe Text + } + deriving (Show, Eq, Generic) + +instance QueryParam CommentParam where + toQueryParam :: CommentParam -> Params + toQueryParam CommentParam {..} = + let projectParam = maybe [] (\pid -> [("project_id", pid)]) project_id + taskParam = maybe [] (\tid -> [("task_id", tid)]) task_id + cursorParam = maybe [] (\c -> [("cursor", c)]) cursor + limitParam = maybe [] (\l -> [("limit", T.pack $ show l)]) limit + publicKeyParam = maybe [] (\pk -> [("public_key", pk)]) public_key + in projectParam <> taskParam <> cursorParam <> limitParam <> publicKeyParam + +{- | Constructor for CommentCreate +Truncates content to 15000 characters (Todoist API limit) +-} +newCommentBuilder :: Text -> Initial CommentCreate +newCommentBuilder content = + let truncated = T.take 15000 content + in seed $ + CommentCreate + { _content = Content truncated + , _project_id = Nothing + , _task_id = Nothing + , _attachment = Nothing + , _uids_to_notify = [] + } + +{- | Constructor for CommentUpdate +Truncates content to 15000 characters (Todoist API limit) +-} +updateCommentBuilder :: Text -> Initial CommentUpdate +updateCommentBuilder content = + let truncated = T.take 15000 content + in seed $ CommentUpdate {_content = Just truncated} + +-- | Create new CommentParam for use with builder pattern +commentParamBuilder :: Initial CommentParam +commentParamBuilder = + seed $ + CommentParam + { project_id = Nothing + , task_id = Nothing + , cursor = Nothing + , limit = Nothing + , public_key = Nothing + } + +-- | Type class for comment operations +class (Monad m) => TodoistCommentM m where + {- | Add a new comment to a project or task + Todo: have it return CommentId + -} + addComment :: CommentCreate -> m Comment + + -- | Get all comments (automatic pagination) + getComments :: CommentParam -> m [Comment] + + -- | Get comments with manual pagination control + getCommentsPaginated :: CommentParam -> m ([Comment], Maybe Text) + + -- | Get a single comment by ID + getComment :: CommentId -> m Comment + + -- | Update a comment's content + updateComment :: CommentUpdate -> CommentId -> m Comment + + -- | Delete a comment + deleteComment :: CommentId -> m () + +-- Builder pattern instances +instance HasContent CommentCreate where + hasContent :: Text -> CommentCreate -> CommentCreate + hasContent content CommentCreate {..} = CommentCreate {_content = Content content, ..} + +instance HasProjectId CommentCreate where + hasProjectId :: Text -> CommentCreate -> CommentCreate + hasProjectId pid CommentCreate {..} = CommentCreate {_project_id = Just (ProjectId pid), ..} + +instance HasTaskId CommentCreate where + hasTaskId :: Text -> CommentCreate -> CommentCreate + hasTaskId tid CommentCreate {..} = CommentCreate {_task_id = Just (TaskId tid), ..} + +instance HasAttachment CommentCreate where + hasAttachment :: Attachment -> CommentCreate -> CommentCreate + hasAttachment att CommentCreate {..} = CommentCreate {_attachment = Just att, ..} + +instance HasUidsToNotify CommentCreate where + hasUidsToNotify :: [Int] -> CommentCreate -> CommentCreate + hasUidsToNotify uids CommentCreate {..} = CommentCreate {_uids_to_notify = uids, ..} + +-- HasX instances for CommentParam +instance HasProjectId CommentParam where + hasProjectId :: Text -> CommentParam -> CommentParam + hasProjectId pid CommentParam {..} = CommentParam {project_id = Just pid, ..} + +instance HasTaskId CommentParam where + hasTaskId :: Text -> CommentParam -> CommentParam + hasTaskId tid CommentParam {..} = CommentParam {task_id = Just tid, ..} + +instance HasCursor CommentParam where + hasCursor :: Text -> CommentParam -> CommentParam + hasCursor c CommentParam {..} = CommentParam {cursor = Just c, ..} + +instance HasLimit CommentParam where + hasLimit :: Int -> CommentParam -> CommentParam + hasLimit l CommentParam {..} = CommentParam {limit = Just l, ..} + +instance HasPublicKey CommentParam where + hasPublicKey :: Text -> CommentParam -> CommentParam + hasPublicKey pk CommentParam {..} = CommentParam {public_key = Just pk, ..} diff --git a/src/Web/Todoist/Domain/Label.hs b/src/Web/Todoist/Domain/Label.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Domain/Label.hs @@ -0,0 +1,346 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} + +{- | +Module : Web.Todoist.Domain.Label +Description : Label API types and operations for Todoist REST API +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +This module provides types and operations for working with Todoist labels. +Labels are tags that can be applied to tasks for categorization and filtering. +Supports both personal and shared labels. + += Usage Example + +@ +import Web.Todoist.Domain.Label +import Web.Todoist.Runner +import Web.Todoist.Util.Builder + +main :: IO () +main = do + let config = newTodoistConfig "your-api-token" + + -- Create a label + let newLbl = runBuilder (createLabelBuilder "urgent") mempty + label <- todoist config (addLabel newLbl) + + -- Get all labels with builder pattern + let params = runBuilder labelParamBuilder (withLimit 50) + labels <- todoist config (getLabels params) +@ + +For more details, see: +-} +module Web.Todoist.Domain.Label + ( -- * Types + Label (..) + , LabelId (..) + , LabelCreate + , LabelUpdate + , LabelParam (..) + , SharedLabelParam (..) + , SharedLabelRemove + , SharedLabelRename + + -- * Type Class + , TodoistLabelM (..) + + -- * Constructors + , createLabelBuilder + , updateLabelBuilder + , labelParamBuilder + , sharedLabelParamBuilder + , mkSharedLabelRename + , mkSharedLabelRemove + + -- * Lenses + , labelId + , labelName + , labelColor + , labelOrder + , labelIsFavorite + ) where + +import Control.Applicative ((<$>)) +import Control.Monad (Monad) +import Data.Aeson (FromJSON (..), ToJSON (..), Value, genericToJSON) +import qualified Data.Aeson as A +import Data.Aeson.Types (Parser) +import Data.Bool (Bool (..)) +import Data.Eq (Eq) +import Data.Function (($)) +import Data.Int (Int) +import qualified Data.List as L +import Data.Maybe (Maybe (..), maybe) +import Data.Monoid ((<>)) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) +import Lens.Micro (to) +import Text.Show (Show, show) +import Web.Todoist.Domain.Types (Color (..), IsFavorite (..), Name (..), Order (..)) +import Web.Todoist.Lens (Getter) +import Web.Todoist.Internal.Types (Params) +import Web.Todoist.Util.Builder + ( HasColor (..) + , HasCursor (..) + , HasIsFavorite (..) + , HasLimit (..) + , HasName (..) + , HasOmitPersonal (..) + , HasOrder (..) + , Initial + , seed + ) +import Web.Todoist.Util.QueryParam (QueryParam (..)) + +-- | Unique identifier for a Label +newtype LabelId = LabelId {getLabelId :: Text} + deriving (Eq, Show, Generic) + +instance ToJSON LabelId where + toJSON :: LabelId -> Value + toJSON (LabelId txt) = A.object ["id" A..= txt] + +instance FromJSON LabelId where + parseJSON :: Value -> Parser LabelId + parseJSON = A.withObject "LabelId" $ \obj -> + LabelId <$> obj A..: "id" + +data Label = Label + { _id :: LabelId + , _name :: Name + , _color :: Color + , _order :: Maybe Order + , _is_favorite :: IsFavorite + } + deriving (Show, Generic) + +-- | Lenses for Label +labelId :: Getter Label LabelId +labelId = to (\(Label {_id = x}) -> x) +{-# INLINE labelId #-} + +labelName :: Getter Label Name +labelName = to (\(Label {_name = x}) -> x) +{-# INLINE labelName #-} + +labelColor :: Getter Label Color +labelColor = to (\(Label {_color = x}) -> x) +{-# INLINE labelColor #-} + +labelOrder :: Getter Label (Maybe Order) +labelOrder = to (\(Label {_order = x}) -> x) +{-# INLINE labelOrder #-} + +labelIsFavorite :: Getter Label IsFavorite +labelIsFavorite = to (\(Label {_is_favorite = x}) -> x) +{-# INLINE labelIsFavorite #-} + +-- | Request body for creating a new Label +data LabelCreate = LabelCreate + { _name :: Name + , _order :: Maybe Order + , _color :: Maybe Color -- Can be string or integer per API, we'll use Text + , _is_favorite :: Maybe IsFavorite + } + deriving (Show, Generic) + +instance ToJSON LabelCreate where + toJSON :: LabelCreate -> A.Value + toJSON = genericToJSON A.defaultOptions {A.fieldLabelModifier = L.drop 1, A.omitNothingFields = True} + +-- | Request body for updating a Label (partial updates) +data LabelUpdate = LabelUpdate + { _name :: Maybe Name + , _order :: Maybe Order + , _color :: Maybe Color + , _is_favorite :: Maybe IsFavorite + } + deriving (Show, Generic) + +instance ToJSON LabelUpdate where + toJSON :: LabelUpdate -> A.Value + toJSON = genericToJSON A.defaultOptions {A.fieldLabelModifier = L.drop 1, A.omitNothingFields = True} + +-- | Query parameters for filtering and paginating labels +data LabelParam = LabelParam + { cursor :: Maybe Text + , limit :: Maybe Int + } + deriving (Show, Generic) + +instance QueryParam LabelParam where + toQueryParam :: LabelParam -> Params + toQueryParam LabelParam {..} = + maybe [] (\c -> [("cursor", c)]) cursor + <> maybe [] (\l -> [("limit", T.pack $ show l)]) limit + +-- | Query parameters for shared labels +data SharedLabelParam = SharedLabelParam + { omit_personal :: Maybe Bool + , cursor :: Maybe Text + , limit :: Maybe Int + } + deriving (Show, Generic) + +instance QueryParam SharedLabelParam where + toQueryParam :: SharedLabelParam -> Params + toQueryParam SharedLabelParam {..} = + let omitParam = case omit_personal of + Just True -> [("omit_personal", "true")] + Just False -> [("omit_personal", "false")] + Nothing -> [] + in omitParam + <> maybe [] (\c -> [("cursor", c)]) cursor + <> maybe [] (\l -> [("limit", T.pack $ show l)]) limit + +-- | Request body for removing a shared label +newtype SharedLabelRemove = SharedLabelRemove + { _name :: Name + } + deriving (Show, Generic) + +instance ToJSON SharedLabelRemove where + toJSON :: SharedLabelRemove -> A.Value + toJSON = genericToJSON A.defaultOptions {A.fieldLabelModifier = L.drop 1} + +-- | Request body for renaming a shared label +data SharedLabelRename = SharedLabelRename + { _name :: Name + , _new_name :: Name + } + deriving (Show, Generic) + +instance ToJSON SharedLabelRename where + toJSON :: SharedLabelRename -> A.Value + toJSON = genericToJSON A.defaultOptions {A.fieldLabelModifier = L.drop 1} + +-- | Type class defining Label operations +class (Monad m) => TodoistLabelM m where + -- | Get all labels (automatically fetches all pages) + getLabels :: LabelParam -> m [Label] + + -- | Get a single label by ID + getLabel :: LabelId -> m Label + + -- | Create a new label + addLabel :: LabelCreate -> m LabelId + + -- | Update a label + updateLabel :: LabelUpdate -> LabelId -> m Label + + -- | Delete a label (removes from all tasks) + deleteLabel :: LabelId -> m () + + -- | Get labels with manual pagination control + getLabelsPaginated :: LabelParam -> m ([Label], Maybe Text) + + -- | Get shared labels (automatically fetches all pages) + getSharedLabels :: SharedLabelParam -> m [Text] + + -- | Get shared labels with manual pagination control + getSharedLabelsPaginated :: SharedLabelParam -> m ([Text], Maybe Text) + + -- | Remove a shared label from all active tasks + removeSharedLabels :: SharedLabelRemove -> m () + + -- | Rename a shared label on all active tasks + renameSharedLabels :: SharedLabelRename -> m () + +-- | Smart constructor for creating a new label +createLabelBuilder :: Text -> Initial LabelCreate +createLabelBuilder name = + seed + LabelCreate + { _name = Name name + , _order = Nothing + , _color = Nothing + , _is_favorite = Nothing + } + +-- | Empty label update for builder pattern +updateLabelBuilder :: Initial LabelUpdate +updateLabelBuilder = + seed + LabelUpdate + { _name = Nothing + , _order = Nothing + , _color = Nothing + , _is_favorite = Nothing + } + +-- | Create new LabelParam for use with builder pattern +labelParamBuilder :: Initial LabelParam +labelParamBuilder = seed $ LabelParam {cursor = Nothing, limit = Nothing} + +-- | Create new SharedLabelRemove for use with builder pattern +mkSharedLabelRename :: Text -> Text -> SharedLabelRename +mkSharedLabelRename name newName= SharedLabelRename {_name = Name name, _new_name = Name newName} + +-- | Create new SharedLabelRemove +mkSharedLabelRemove :: Text -> SharedLabelRemove +mkSharedLabelRemove name = SharedLabelRemove {_name = Name name} + +-- | Create new SharedLabelParam for use with builder pattern +sharedLabelParamBuilder :: Initial SharedLabelParam +sharedLabelParamBuilder = seed $ SharedLabelParam {omit_personal = Nothing, cursor = Nothing, limit = Nothing} + +-- Builder instances for ergonomic construction +instance HasName LabelCreate where + hasName :: Text -> LabelCreate -> LabelCreate + hasName name LabelCreate {..} = LabelCreate {_name = Name name, ..} + +instance HasOrder LabelCreate where + hasOrder :: Int -> LabelCreate -> LabelCreate + hasOrder order LabelCreate {..} = LabelCreate {_order = Just (Order order), ..} + +instance HasColor LabelCreate where + hasColor :: Text -> LabelCreate -> LabelCreate + hasColor color LabelCreate {..} = LabelCreate {_color = Just (Color color), ..} + +instance HasIsFavorite LabelCreate where + hasIsFavorite :: Bool -> LabelCreate -> LabelCreate + hasIsFavorite fav LabelCreate {..} = LabelCreate {_is_favorite = Just (IsFavorite fav), ..} + +instance HasName LabelUpdate where + hasName :: Text -> LabelUpdate -> LabelUpdate + hasName name LabelUpdate {..} = LabelUpdate {_name = Just (Name name), ..} + +instance HasOrder LabelUpdate where + hasOrder :: Int -> LabelUpdate -> LabelUpdate + hasOrder order LabelUpdate {..} = LabelUpdate {_order = Just (Order order), ..} + +instance HasColor LabelUpdate where + hasColor :: Text -> LabelUpdate -> LabelUpdate + hasColor color LabelUpdate {..} = LabelUpdate {_color = Just (Color color), ..} + +instance HasIsFavorite LabelUpdate where + hasIsFavorite :: Bool -> LabelUpdate -> LabelUpdate + hasIsFavorite fav LabelUpdate {..} = LabelUpdate {_is_favorite = Just (IsFavorite fav), ..} + +-- HasX instances for LabelParam +instance HasCursor LabelParam where + hasCursor :: Text -> LabelParam -> LabelParam + hasCursor c LabelParam {..} = LabelParam {cursor = Just c, ..} + +instance HasLimit LabelParam where + hasLimit :: Int -> LabelParam -> LabelParam + hasLimit l LabelParam {..} = LabelParam {limit = Just l, ..} + +-- HasX instances for SharedLabelParam +instance HasOmitPersonal SharedLabelParam where + hasOmitPersonal :: Bool -> SharedLabelParam -> SharedLabelParam + hasOmitPersonal omit SharedLabelParam {..} = SharedLabelParam {omit_personal = Just omit, ..} + +instance HasCursor SharedLabelParam where + hasCursor :: Text -> SharedLabelParam -> SharedLabelParam + hasCursor c SharedLabelParam {..} = SharedLabelParam {cursor = Just c, ..} + +instance HasLimit SharedLabelParam where + hasLimit :: Int -> SharedLabelParam -> SharedLabelParam + hasLimit l SharedLabelParam {..} = SharedLabelParam {limit = Just l, ..} diff --git a/src/Web/Todoist/Domain/Project.hs b/src/Web/Todoist/Domain/Project.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Domain/Project.hs @@ -0,0 +1,527 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} + +{- | +Module : Web.Todoist.Domain.Project +Description : Project API types and operations for Todoist REST API +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +This module provides types and operations for working with Todoist projects. +Projects are used to organize tasks into groups, support hierarchical nesting, +and can be displayed in list, board, or calendar view. + += Usage Example + +@ +import Web.Todoist.Domain.Project +import Web.Todoist.Util.Builder +import Web.Todoist.Runner + +main :: IO () +main = do + let config = newTodoistConfig "your-api-token" + + -- Create a new project + let newProj = runBuilder (createProjectBuilder "My Project") + (withDescription "Project description" <> withViewStyle Board) + project <- todoist config (addProject newProj) + + -- Get all projects + projects <- todoist config getAllProjects + + -- Update a project + let update = runBuilder updateProjectBuilder (withName "Updated Name") + updated <- todoist config (updateProject update projectId) +@ + +For more details, see: +-} +module Web.Todoist.Domain.Project + ( TodoistProjectM (..) + , Project (..) + , Collaborator (..) + , ProjectCreate + , ProjectUpdate (..) + , PaginationParam (..) + , createProjectBuilder + , updateProjectBuilder + , paginationParamBuilder + , IsShared (..) + , IsArchived (..) + , CanAssignTasks (..) + -- * Lenses + , projectId + , name + , description + , order + , color + , isCollapsed + , isShared + , isFavorite + , isArchived + , canAssignTasks + , viewStyle + , createdAt + , updatedAt + , collaboratorId + , collaboratorName + , collaboratorEmail + -- * ProjectCreate Lenses + , projectCreateName + , projectCreateDescription + , projectCreateParentId + , projectCreateColor + , projectCreateIsFavorite + , projectCreateViewStyle + , projectCreateWorkspaceId + -- * ProjectUpdate Lenses + , projectUpdateName + , projectUpdateDescription + , projectUpdateColor + , projectUpdateIsFavorite + , projectUpdateViewStyle + ) where + +import Web.Todoist.Domain.Types + ( Color (..) + , Description (..) + , IsCollapsed (..) + , IsFavorite (..) + , Name (..) + , Order (..) + , ProjectId (..) + , ViewStyle (..) + ) +import Web.Todoist.Internal.Types (Params, ProjectPermissions) +import Web.Todoist.Util.Builder + ( HasCursor (..) + , HasColor (..) + , HasDescription (..) + , HasIsFavorite (..) + , HasLimit (..) + , HasName (..) + , HasParentId (..) + , HasViewStyle (..) + , HasWorkspaceId (..) + , Initial + , seed + ) +import Web.Todoist.Util.QueryParam (QueryParam (..)) + +import Control.Applicative ((<|>)) +import Control.Monad (Monad) +import Data.Aeson + ( FromJSON (parseJSON) + , ToJSON (toJSON) + , Value + , defaultOptions + , fieldLabelModifier + , genericParseJSON + , genericToJSON + , omitNothingFields + ) +import Data.Aeson.Types (Parser) +import Data.Bool (Bool (False, True)) +import Data.Eq (Eq) +import Data.Function (($)) +import Data.Functor ((<$>)) +import Data.Int (Int) +import qualified Data.List as L +import Data.Maybe (Maybe (Just, Nothing), maybe) +import Data.Monoid ((<>)) +import Data.String (String) +import Data.Text (Text) +import qualified Data.Text +import GHC.Generics (Generic) +import Lens.Micro (to) +import Text.Show (Show) +import Web.Todoist.Lens (Getter) + +{- | Project domain type representing a Todoist project + +Contains all project metadata including name, color, view style, and hierarchical +information. Projects can be nested using parent_id and organized visually +using order and view_style. +-} +data Project = Project + { _id :: ProjectId + , _name :: Name + , _description :: Description + , _order :: Order + , _color :: Color + , _is_collapsed :: IsCollapsed + , _is_shared :: IsShared + , _is_favorite :: IsFavorite + , _is_archived :: IsArchived + , _can_assign_tasks :: CanAssignTasks + , _view_style :: ViewStyle + , _created_at :: Maybe Text + , _updated_at :: Maybe Text + } + deriving (Show, Eq) + +-- | Lenses for Project +projectId :: Getter Project ProjectId +projectId = to (\(Project {_id = x}) -> x) +{-# INLINE projectId #-} + +name :: Getter Project Name +name = to (\(Project {_name = x}) -> x) +{-# INLINE name #-} + +description :: Getter Project Description +description = to (\(Project {_description = x}) -> x) +{-# INLINE description #-} + +order :: Getter Project Order +order = to (\(Project {_order = x}) -> x) +{-# INLINE order #-} + +color :: Getter Project Color +color = to (\(Project {_color = x}) -> x) +{-# INLINE color #-} + +isCollapsed :: Getter Project IsCollapsed +isCollapsed = to (\(Project {_is_collapsed = x}) -> x) +{-# INLINE isCollapsed #-} + +isShared :: Getter Project IsShared +isShared = to (\(Project {_is_shared = x}) -> x) +{-# INLINE isShared #-} + +isFavorite :: Getter Project IsFavorite +isFavorite = to (\(Project {_is_favorite = x}) -> x) +{-# INLINE isFavorite #-} + +isArchived :: Getter Project IsArchived +isArchived = to (\(Project {_is_archived = x}) -> x) +{-# INLINE isArchived #-} + +canAssignTasks :: Getter Project CanAssignTasks +canAssignTasks = to (\(Project {_can_assign_tasks = x}) -> x) +{-# INLINE canAssignTasks #-} + +viewStyle :: Getter Project ViewStyle +viewStyle = to (\(Project {_view_style = x}) -> x) +{-# INLINE viewStyle #-} + +createdAt :: Getter Project (Maybe Text) +createdAt = to (\(Project {_created_at = x}) -> x) +{-# INLINE createdAt #-} + +updatedAt :: Getter Project (Maybe Text) +updatedAt = to (\(Project {_updated_at = x}) -> x) +{-# INLINE updatedAt #-} + +{- | Request body for creating a new project + +All fields except name are optional. Use the builder pattern with 'createProjectBuilder' +for ergonomic construction. +-} +data ProjectCreate = ProjectCreate + { _name :: Name + , _description :: Maybe Description + , _parent_id :: Maybe ParentId + , _color :: Maybe Color -- Default: {"name":"charcoal","hex":"#808080","database_index":47} + , _is_favorite :: IsFavorite + , _view_style :: Maybe ViewStyle + , _workspace_id :: Maybe Int + } + deriving (Show, Generic) + +instance ToJSON ProjectCreate where + toJSON :: ProjectCreate -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1, omitNothingFields = True} + +instance FromJSON ProjectCreate where + parseJSON :: Value -> Parser ProjectCreate + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = L.drop 1} + +instance HasDescription ProjectCreate where + hasDescription :: Text -> ProjectCreate -> ProjectCreate + hasDescription desc ProjectCreate {..} = ProjectCreate {_description = Just (Description desc), ..} + +instance HasParentId ProjectCreate where + hasParentId :: Text -> ProjectCreate -> ProjectCreate + hasParentId pid ProjectCreate {..} = ProjectCreate {_parent_id = Just (ParentIdStr (Data.Text.unpack pid)), ..} + +instance HasViewStyle ProjectCreate where + hasViewStyle :: ViewStyle -> ProjectCreate -> ProjectCreate + hasViewStyle style ProjectCreate {..} = ProjectCreate {_view_style = Just style, ..} + +instance HasWorkspaceId ProjectCreate where + hasWorkspaceId :: Int -> ProjectCreate -> ProjectCreate + hasWorkspaceId wid ProjectCreate {..} = ProjectCreate {_workspace_id = Just wid, ..} + +-- | Lenses for ProjectCreate +projectCreateName :: Getter ProjectCreate Name +projectCreateName = to (\(ProjectCreate {_name = x}) -> x) +{-# INLINE projectCreateName #-} + +projectCreateDescription :: Getter ProjectCreate (Maybe Description) +projectCreateDescription = to (\(ProjectCreate {_description = x}) -> x) +{-# INLINE projectCreateDescription #-} + +projectCreateParentId :: Getter ProjectCreate (Maybe ParentId) +projectCreateParentId = to (\(ProjectCreate {_parent_id = x}) -> x) +{-# INLINE projectCreateParentId #-} + +projectCreateColor :: Getter ProjectCreate (Maybe Color) +projectCreateColor = to (\(ProjectCreate {_color = x}) -> x) +{-# INLINE projectCreateColor #-} + +projectCreateIsFavorite :: Getter ProjectCreate IsFavorite +projectCreateIsFavorite = to (\(ProjectCreate {_is_favorite = x}) -> x) +{-# INLINE projectCreateIsFavorite #-} + +projectCreateViewStyle :: Getter ProjectCreate (Maybe ViewStyle) +projectCreateViewStyle = to (\(ProjectCreate {_view_style = x}) -> x) +{-# INLINE projectCreateViewStyle #-} + +projectCreateWorkspaceId :: Getter ProjectCreate (Maybe Int) +projectCreateWorkspaceId = to (\(ProjectCreate {_workspace_id = x}) -> x) +{-# INLINE projectCreateWorkspaceId #-} + +{- | Request body type for updating an existing project +All fields are optional to support partial updates +-} +data ProjectUpdate = ProjectUpdate + { _name :: Maybe Name + , _description :: Maybe Description + , _color :: Maybe Color -- Note: API accepts string or integer, using Text for now + , _is_favorite :: Maybe IsFavorite + , _view_style :: Maybe ViewStyle + } + deriving (Show, Eq, Generic) + +instance ToJSON ProjectUpdate where + toJSON :: ProjectUpdate -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1, omitNothingFields = True} + +instance FromJSON ProjectUpdate where + parseJSON :: Value -> Parser ProjectUpdate + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = L.drop 1} + +instance HasName ProjectUpdate where + hasName :: Text -> ProjectUpdate -> ProjectUpdate + hasName name ProjectUpdate {..} = ProjectUpdate {_name = Just (Name name), ..} + +instance HasDescription ProjectUpdate where + hasDescription :: Text -> ProjectUpdate -> ProjectUpdate + hasDescription desc ProjectUpdate {..} = ProjectUpdate {_description = Just (Description desc), ..} + +instance HasViewStyle ProjectUpdate where + hasViewStyle :: ViewStyle -> ProjectUpdate -> ProjectUpdate + hasViewStyle style ProjectUpdate {..} = ProjectUpdate {_view_style = Just style, ..} + +instance HasIsFavorite ProjectUpdate where + hasIsFavorite :: Bool -> ProjectUpdate -> ProjectUpdate + hasIsFavorite fav ProjectUpdate {..} = ProjectUpdate {_is_favorite = Just (IsFavorite fav), ..} + +instance HasColor ProjectUpdate where + hasColor :: Text -> ProjectUpdate -> ProjectUpdate + hasColor col ProjectUpdate {..} = ProjectUpdate {_color = Just (Color col), ..} + +-- | Lenses for ProjectUpdate +projectUpdateName :: Getter ProjectUpdate (Maybe Name) +projectUpdateName = to (\(ProjectUpdate {_name = x}) -> x) +{-# INLINE projectUpdateName #-} + +projectUpdateDescription :: Getter ProjectUpdate (Maybe Description) +projectUpdateDescription = to (\(ProjectUpdate {_description = x}) -> x) +{-# INLINE projectUpdateDescription #-} + +projectUpdateColor :: Getter ProjectUpdate (Maybe Color) +projectUpdateColor = to (\(ProjectUpdate {_color = x}) -> x) +{-# INLINE projectUpdateColor #-} + +projectUpdateIsFavorite :: Getter ProjectUpdate (Maybe IsFavorite) +projectUpdateIsFavorite = to (\(ProjectUpdate {_is_favorite = x}) -> x) +{-# INLINE projectUpdateIsFavorite #-} + +projectUpdateViewStyle :: Getter ProjectUpdate (Maybe ViewStyle) +projectUpdateViewStyle = to (\(ProjectUpdate {_view_style = x}) -> x) +{-# INLINE projectUpdateViewStyle #-} + +-- projects +createProjectBuilder :: Text -> Initial ProjectCreate +createProjectBuilder name = + seed + ProjectCreate + { _name = Name name + , _description = Nothing + , _parent_id = Nothing + , _color = Nothing + , _is_favorite = IsFavorite False + , _view_style = Nothing + , _workspace_id = Nothing + } + +{- | Create an empty ProjectUpdate (for use with Builder combinators) +Use with runBuilder: runBuilder updateProjectBuilder (withName "New Name" <> withDescription "desc") +-} +updateProjectBuilder :: Initial ProjectUpdate +updateProjectBuilder = + seed + ProjectUpdate + { _name = Nothing + , _description = Nothing + , _color = Nothing + , _is_favorite = Nothing + , _view_style = Nothing + } + +data Collaborator = Collaborator + { _id :: Text + , _name :: Name + , _email :: Text + } + deriving (Show, Eq, Generic) + +instance ToJSON Collaborator where + toJSON :: Collaborator -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1} + +instance FromJSON Collaborator where + parseJSON :: Value -> Parser Collaborator + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = L.drop 1} + +-- | Lenses for Collaborator +collaboratorId :: Getter Collaborator Text +collaboratorId = to (\(Collaborator {_id = x}) -> x) +{-# INLINE collaboratorId #-} + +collaboratorName :: Getter Collaborator Name +collaboratorName = to (\(Collaborator {_name = x}) -> x) +{-# INLINE collaboratorName #-} + +collaboratorEmail :: Getter Collaborator Text +collaboratorEmail = to (\(Collaborator {_email = x}) -> x) +{-# INLINE collaboratorEmail #-} + +{- | Query parameters for paginated requests +Used for projects and collaborators endpoints +-} +data PaginationParam = PaginationParam + { cursor :: Maybe Text + , limit :: Maybe Int + } + deriving (Show, Eq) + +instance QueryParam PaginationParam where + toQueryParam :: PaginationParam -> Params + toQueryParam PaginationParam {..} = + maybe [] (\c -> [("cursor", c)]) cursor + <> maybe [] (\l -> [("limit", Data.Text.show l)]) limit + +-- | Create new PaginationParam for use with builder pattern +paginationParamBuilder :: Initial PaginationParam +paginationParamBuilder = seed $ PaginationParam {cursor = Nothing, limit = Nothing} + +-- HasX instances for builder pattern +instance HasCursor PaginationParam where + hasCursor :: Text -> PaginationParam -> PaginationParam + hasCursor c PaginationParam {..} = PaginationParam {cursor = Just c, ..} + +instance HasLimit PaginationParam where + hasLimit :: Int -> PaginationParam -> PaginationParam + hasLimit l PaginationParam {..} = PaginationParam {limit = Just l, ..} + +data ParentId = ParentIdStr String | ParentIdInt Int deriving (Show, Generic) + +instance ToJSON ParentId where + toJSON :: ParentId -> Value + toJSON (ParentIdStr s) = toJSON s + toJSON (ParentIdInt i) = toJSON i + +instance FromJSON ParentId where + parseJSON :: Value -> Parser ParentId + parseJSON v = (ParentIdStr <$> parseJSON v) <|> (ParentIdInt <$> parseJSON v) + +class (Monad m) => TodoistProjectM m where + -- | Get all projects (automatically fetches all pages) + getAllProjects :: m [Project] + + -- | Get a single project by ID + getProject :: ProjectId -> m Project + + -- | Get all collaborators for a project (automatically fetches all pages) + getProjectCollaborators :: ProjectId -> m [Collaborator] + + -- | Create a new project + addProject :: ProjectCreate -> m ProjectId + + -- | Delete a project and all its tasks + deleteProject :: ProjectId -> m () + + -- | Archive a project (hides from active view but preserves data) + archiveProject :: ProjectId -> m ProjectId + + -- | Unarchive a previously archived project + unarchiveProject :: ProjectId -> m ProjectId + + getProjectPermissions :: m ProjectPermissions + + -- | Update an existing project + updateProject :: ProjectUpdate -> ProjectId -> m Project + + {- | Get projects with manual pagination control + Returns a tuple of (results, next_cursor) for the requested page + -} + getAllProjectsPaginated :: PaginationParam -> m ([Project], Maybe Text) + + {- | Get project collaborators with manual pagination control + Returns a tuple of (results, next_cursor) for the requested page + -} + getProjectCollaboratorsPaginated :: PaginationParam -> ProjectId -> m ([Collaborator], Maybe Text) + + -- | Get all projects with custom page size (fetches all pages automatically) + getAllProjectsWithLimit :: Int -> m [Project] + + -- | Get all project collaborators with custom page size (fetches all pages automatically) + getProjectCollaboratorsWithLimit :: Int -> ProjectId -> m [Collaborator] + +newtype IsShared = IsShared {getIsShared :: Bool} deriving (Show, Eq, Generic) + +instance FromJSON IsShared where + parseJSON :: Value -> Parser IsShared + parseJSON v = IsShared <$> parseJSON v + +instance ToJSON IsShared where + toJSON :: IsShared -> Value + toJSON (IsShared txt) = toJSON txt + +newtype IsArchived = IsArchived {getIsArchived :: Bool} deriving (Show, Eq, Generic) + +instance FromJSON IsArchived where + parseJSON :: Value -> Parser IsArchived + parseJSON v = IsArchived <$> parseJSON v + +instance ToJSON IsArchived where + toJSON :: IsArchived -> Value + toJSON (IsArchived txt) = toJSON txt + +newtype CanAssignTasks = CanAssignTasks {getCanAssignTasks :: Bool} deriving (Show, Eq, Generic) + +instance FromJSON CanAssignTasks where + parseJSON :: Value -> Parser CanAssignTasks + parseJSON v = CanAssignTasks <$> parseJSON v + +instance ToJSON CanAssignTasks where + toJSON :: CanAssignTasks -> Value + toJSON (CanAssignTasks txt) = toJSON txt + +newtype Email = Email {getEmail :: Text} deriving (Show, Eq, Generic) + +instance FromJSON Email where + parseJSON :: Value -> Parser Email + parseJSON v = Email <$> parseJSON v + +instance ToJSON Email where + toJSON :: Email -> Value + toJSON (Email txt) = toJSON txt diff --git a/src/Web/Todoist/Domain/Section.hs b/src/Web/Todoist/Domain/Section.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Domain/Section.hs @@ -0,0 +1,263 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} + +{- | +Module : Web.Todoist.Domain.Section +Description : Section API types and operations for Todoist REST API +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +This module provides types and operations for working with Todoist sections. +Sections are used to organize tasks within a project into logical groups. + += Usage Example + +@ +import Web.Todoist.Domain.Section +import Web.Todoist.Runner +import Web.Todoist.Util.Builder + +main :: IO () +main = do + let config = newTodoistConfig "your-api-token" + + -- Create a section in a project + let newSec = runBuilder (newSectionBuilder "To Do" "project-id-123") mempty + section <- todoist config (addSection newSec) + + -- Get all sections in a project with builder pattern + let params = runBuilder sectionParamBuilder (withProjectId "project-id-123" <> withLimit 50) + sections <- todoist config (getSections params) +@ + +For more details, see: +-} +module Web.Todoist.Domain.Section + ( -- * Types + Section (..) + , SectionId (..) + , SectionCreate + , SectionUpdate + , SectionParam (..) + + -- * Type Class + , TodoistSectionM (..) + + -- * Constructors + , newSectionBuilder + , updateSectionBuilder + , sectionParamBuilder + + -- * Lenses + , sectionId + , sectionName + , sectionProjectId + , sectionIsCollapsed + , sectionOrder + ) where + +import Data.Aeson + ( FromJSON (..) + , ToJSON (..) + , Value + , genericParseJSON + , genericToJSON + ) +import Data.Aeson.Types (Parser) +import Data.Bool (Bool (True)) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) +import Lens.Micro (to) +import Web.Todoist.Lens (Getter) + +import qualified Data.Aeson as A +import qualified Data.List as L + +import Control.Monad (Monad) +import Data.Eq (Eq) +import Data.Function (($)) +import Data.Int (Int) +import Data.Maybe (Maybe (..)) +import Data.Monoid ((<>)) +import Text.Show (Show (..)) +import Web.Todoist.Domain.Types (IsCollapsed, Name (..), Order (..), ProjectId (..), getProjectId) +import Web.Todoist.Util.Builder + ( HasCursor (..) + , HasLimit (..) + , HasName (..) + , HasOrder (..) + , HasProjectId (..) + , Initial + , seed + ) +import Web.Todoist.Util.QueryParam (QueryParam (..)) + +-- | Unique identifier for a Section +newtype SectionId = SectionId {_id :: Text} + deriving (Eq, Show, Generic) + +instance FromJSON SectionId where + parseJSON :: Value -> Parser SectionId + parseJSON = genericParseJSON A.defaultOptions {A.fieldLabelModifier = L.drop 1} + +instance ToJSON SectionId where + toJSON :: SectionId -> Value + toJSON (SectionId txt) = toJSON txt + +{- | Simplified domain representation of a Section (5 essential fields) +Note: API returns 11 fields, but we only expose the essential ones +-} +data Section = Section + { _id :: SectionId + , _name :: Name + , _project_id :: ProjectId + , _is_collapsed :: IsCollapsed + , _order :: Order -- Maps from section_order in API + } + deriving (Show, Generic) + +-- | Lenses for Section +sectionId :: Getter Section SectionId +sectionId = to (\(Section {_id = x}) -> x) +{-# INLINE sectionId #-} + +sectionName :: Getter Section Name +sectionName = to (\(Section {_name = x}) -> x) +{-# INLINE sectionName #-} + +sectionProjectId :: Getter Section ProjectId +sectionProjectId = to (\(Section {_project_id = x}) -> x) +{-# INLINE sectionProjectId #-} + +sectionIsCollapsed :: Getter Section IsCollapsed +sectionIsCollapsed = to (\(Section {_is_collapsed = x}) -> x) +{-# INLINE sectionIsCollapsed #-} + +sectionOrder :: Getter Section Order +sectionOrder = to (\(Section {_order = x}) -> x) +{-# INLINE sectionOrder #-} + +-- | Request body for creating a new Section +data SectionCreate = SectionCreate + { _name :: Name + , _project_id :: ProjectId + , _order :: Maybe Order + } + deriving (Show, Generic) + +instance ToJSON SectionCreate where + toJSON :: SectionCreate -> Value + toJSON = genericToJSON A.defaultOptions {A.fieldLabelModifier = L.drop 1} + +{- | Request body for updating a Section (partial updates) +Uses omitNothingFields to only send fields that are set +-} +newtype SectionUpdate = SectionUpdate + { _name :: Maybe Name + } + deriving (Show, Generic) + +instance ToJSON SectionUpdate where + toJSON :: SectionUpdate -> Value + toJSON = genericToJSON A.defaultOptions {A.fieldLabelModifier = L.drop 1, A.omitNothingFields = True} + +-- | Query parameters for filtering and paginating sections +data SectionParam = SectionParam + { project_id :: Maybe ProjectId + , cursor :: Maybe Text + , limit :: Maybe Int + } + deriving (Show, Generic) + +instance QueryParam SectionParam where + toQueryParam :: SectionParam -> [(Text, Text)] + toQueryParam SectionParam {..} = + let projectIdParam = case project_id of + Just pid -> [("project_id", getProjectId pid)] + Nothing -> [] + cursorParam = case cursor of + Just c -> [("cursor", c)] + Nothing -> [] + limitParam = case limit of + Just l -> [("limit", T.pack $ show l)] + Nothing -> [] + in projectIdParam <> cursorParam <> limitParam + +-- | Type class defining Section operations +class (Monad m) => TodoistSectionM m where + -- | Get all sections (automatically fetches all pages) + getSections :: SectionParam -> m [Section] + + -- | Get a single section by ID + getSection :: SectionId -> m Section + + -- | Create a new section + addSection :: SectionCreate -> m SectionId + + -- | Update a section + updateSection :: SectionUpdate -> SectionId -> m Section + + -- | Delete a section (and all its tasks) + deleteSection :: SectionId -> m () + + {- | Get sections with manual pagination control + Returns a tuple of (results, next_cursor) for the requested page + -} + getSectionsPaginated :: SectionParam -> m ([Section], Maybe Text) + +-- | Smart constructor for creating a new section +newSectionBuilder :: Text -> Text -> Initial SectionCreate +newSectionBuilder name projectId = + seed + SectionCreate + { _name = Name name + , _project_id = ProjectId projectId + , _order = Nothing + } + +-- | Empty section update for builder pattern +updateSectionBuilder :: Initial SectionUpdate +updateSectionBuilder = + seed + SectionUpdate + { _name = Nothing + } + +-- | Create new SectionParam for use with builder pattern +sectionParamBuilder :: Initial SectionParam +sectionParamBuilder = + seed + SectionParam + { project_id = Nothing + , cursor = Nothing + , limit = Nothing + } + +-- Builder instances for ergonomic construction +instance HasName SectionCreate where + hasName :: Text -> SectionCreate -> SectionCreate + hasName name SectionCreate {..} = SectionCreate {_name = Name name, ..} + +instance HasOrder SectionCreate where + hasOrder :: Int -> SectionCreate -> SectionCreate + hasOrder order SectionCreate {..} = SectionCreate {_order = Just (Order order), ..} + +instance HasName SectionUpdate where + hasName :: Text -> SectionUpdate -> SectionUpdate + hasName name SectionUpdate {} = SectionUpdate {_name = Just (Name name), ..} + +-- HasX instances for SectionParam +instance HasProjectId SectionParam where + hasProjectId :: Text -> SectionParam -> SectionParam + hasProjectId pid SectionParam {..} = SectionParam {project_id = Just (ProjectId pid), ..} + +instance HasCursor SectionParam where + hasCursor :: Text -> SectionParam -> SectionParam + hasCursor c SectionParam {..} = SectionParam {cursor = Just c, ..} + +instance HasLimit SectionParam where + hasLimit :: Int -> SectionParam -> SectionParam + hasLimit l SectionParam {..} = SectionParam {limit = Just l, ..} diff --git a/src/Web/Todoist/Domain/Task.hs b/src/Web/Todoist/Domain/Task.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Domain/Task.hs @@ -0,0 +1,1072 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} + +{- | +Module : Web.Todoist.Domain.Task +Description : Task API types and operations for Todoist REST API +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +This module provides types and operations for working with Todoist tasks. +Tasks are the core items in Todoist, supporting due dates, priorities, labels, +assignees, and hierarchical sub-tasks. + += Usage Example + +@ +import Web.Todoist.Domain.Task +import Web.Todoist.Util.Builder +import Web.Todoist.Runner + +main :: IO () +main = do + let config = newTodoistConfig "your-api-token" + + -- Create a new task + let task = runBuilder (newTaskBuilder "Buy groceries") + (withDescription "Milk, eggs, bread" <> withPriority 2) + taskId <- todoist config (createTask task) + + -- Get all tasks with builder pattern + let params = runBuilder taskParamBuilder (withProjectId "project-123" <> withLimit 50) + tasks <- todoist config (getTasks params) + + -- Complete a task + todoist config (closeTask taskId) +@ + +For more details, see: +-} +module Web.Todoist.Domain.Task + ( TodoistTaskM (..) + , TaskParam (..) + , Task (..) + , Due (..) + , Deadline (..) + , Duration (..) + , DurationUnit (..) + , NewTask (..) + , MoveTask + , AddTaskQuick + , addTaskQuickText + , CompletedTasksQueryParamAPI (..) + , TaskCompletedItem (..) + , TaskFilter (..) + , CompletedTasksQueryParam (..) + , TaskCreate + , TaskUpdate + , newTaskBuilder + , moveTaskBuilder + , updateTaskBuilder + , taskParamBuilder + , filterTaskBuilder + , completedTasksQueryParamBuilder + -- * Lenses + -- ** Duration + , amount + , unit + -- ** Deadline + , deadlineDate + , deadlineLang + -- ** Due + , dueDate + , dueString + , dueLang + , dueIsRecurring + , dueTimezone + -- ** Task + , taskId + , taskContent + , taskDescription + , taskProjectId + , taskSectionId + , taskParentId + , taskLabels + , taskPriority + , taskDue + , taskDeadline + , taskDuration + , taskIsCollapsed + , taskOrder + , taskAssigneeId + , taskAssignerId + , taskCompletedAt + , taskCreatorId + , taskCreatedAt + , taskUpdatedAt + -- ** NewTask + , newTaskUserId + , newTaskId + , newTaskProjectId + , newTaskSectionId + , newTaskParentId + , newTaskAddedByUid + , newTaskAssignedByUid + , newTaskResponsibleUid + , newTaskLabels + , newTaskChecked + , newTaskIsDeleted + , newTaskAddedAt + , newTaskCompletedAt + , newTaskUpdatedAt + , newTaskPriority + , newTaskChildOrder + , newTaskContent + , newTaskDescription + , newTaskNoteCount + , newTaskDayOrder + , newTaskIsCollapsed + -- ** MoveTask + , moveTaskProjectId + , moveTaskSectionId + , moveTaskParentId + -- ** AddTaskQuick + , addTaskQuickTextLens + , addTaskQuickNote + , addTaskQuickReminder + , addTaskQuickAutoReminder + , addTaskQuickMeta + ) where + +import Web.Todoist.Internal.Types (Params) +import Web.Todoist.Util.Builder + ( HasAssigneeId (..) + , HasContent (..) + , HasCursor (..) + , HasDeadlineDate (..) + , HasDescription (..) + , HasDueDate (..) + , HasDueDatetime (..) + , HasDueLang (..) + , HasDueString (..) + , HasDuration (..) + , HasDurationUnit (..) + , HasFilterLang (..) + , HasFilterQuery (..) + , HasLabels (..) + , HasLang (..) + , HasLimit (..) + , HasOrder (..) + , HasParentId (..) + , HasPriority (..) + , HasProjectId (..) + , HasSectionId (..) + , HasTaskIds (..) + , Initial + , seed + ) +import Web.Todoist.Util.QueryParam (QueryParam (..)) + +import Control.Monad (Monad) +import Data.Aeson + ( FromJSON (parseJSON) + , Options (..) + , ToJSON (toJSON) + , Value + , defaultOptions + , genericParseJSON + , genericToJSON + , omitNothingFields + ) +import Data.Aeson.Types (Parser) +import Data.Bool (Bool (..)) +import Data.Eq (Eq) +import Data.Int (Int) +import qualified Data.List as L +import Data.Maybe (Maybe (..), maybe) +import Data.Monoid ((<>)) +import Data.Text (Text) +import qualified Data.Text +import GHC.Generics (Generic) +import Lens.Micro (to) +import Text.Show (Show) +import Web.Todoist.Lens (Getter) +import Web.Todoist.Domain.Section (SectionId (..)) +import Web.Todoist.Domain.Types + ( Content (..) + , Description (..) + , IsCollapsed (..) + , Order (..) + , ParentId (..) + , ProjectId (..) + , TaskId (..) + , Uid + ) + +-- | Duration unit for tasks +data DurationUnit = Minute | Day + deriving (Show, Eq, Generic) + +instance FromJSON DurationUnit where + parseJSON :: Value -> Parser DurationUnit + parseJSON = genericParseJSON defaultOptions + +instance ToJSON DurationUnit where + toJSON :: DurationUnit -> Value + toJSON Minute = "minute" + toJSON Day = "day" + +-- | Duration information for a task +data Duration = Duration + { _amount :: Int + , _unit :: DurationUnit + } + deriving (Show, Generic) + +instance FromJSON Duration where + parseJSON :: Value -> Parser Duration + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = L.drop 1} + +instance ToJSON Duration where + toJSON :: Duration -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1} + +-- | Lenses for Duration +amount :: Getter Duration Int +amount = to _amount +{-# INLINE amount #-} + +unit :: Getter Duration DurationUnit +unit = to _unit +{-# INLINE unit #-} + +-- | Deadline information for a task +data Deadline = Deadline + { _date :: Text + , _lang :: Text + } + deriving (Show, Generic) + +instance FromJSON Deadline where + parseJSON :: Value -> Parser Deadline + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = L.drop 1} + +instance ToJSON Deadline where + toJSON :: Deadline -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1} + +-- | Lenses for Deadline +deadlineDate :: Getter Deadline Text +deadlineDate = to (\(Deadline {_date = x}) -> x) +{-# INLINE deadlineDate #-} + +deadlineLang :: Getter Deadline Text +deadlineLang = to (\(Deadline {_lang = x}) -> x) +{-# INLINE deadlineLang #-} + +-- | Due date information for a task +data Due = Due + { _date :: Text + , _string :: Text + , _lang :: Text + , _is_recurring :: Bool + , _timezone :: Maybe Text + } + deriving (Show, Generic) + +instance FromJSON Due where + parseJSON :: Value -> Parser Due + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = L.drop 1} + +instance ToJSON Due where + toJSON :: Due -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1} + +-- | Lenses for Due +dueDate :: Getter Due Text +dueDate = to (\(Due {_date = x}) -> x) +{-# INLINE dueDate #-} + +dueString :: Getter Due Text +dueString = to (\(Due {_string = x}) -> x) +{-# INLINE dueString #-} + +dueLang :: Getter Due Text +dueLang = to (\(Due {_lang = x}) -> x) +{-# INLINE dueLang #-} + +dueIsRecurring :: Getter Due Bool +dueIsRecurring = to (\(Due {_is_recurring = x}) -> x) +{-# INLINE dueIsRecurring #-} + +dueTimezone :: Getter Due (Maybe Text) +dueTimezone = to (\(Due {_timezone = x}) -> x) +{-# INLINE dueTimezone #-} + +{- | Task domain type representing a Todoist task + +Contains all task metadata including content, project/section assignment, +due dates, priority, labels, and completion status. Tasks can have sub-tasks +using parent_id and support rich due date information with recurring patterns. +-} +data Task = Task + { _id :: TaskId + , _content :: Content + , _description :: Description + , _project_id :: ProjectId + , _section_id :: Maybe SectionId + , _parent_id :: Maybe ParentId + , _labels :: [Text] + , _priority :: Int + , _due :: Maybe Due + , _deadline :: Maybe Deadline + , _duration :: Maybe Duration + , _is_collapsed :: IsCollapsed + , _order :: Order + , _assignee_id :: Maybe Uid + , _assigner_id :: Maybe Uid + , _completed_at :: Maybe Text + , _creator_id :: Uid + , _created_at :: Text + , _updated_at :: Text + } + deriving (Show, Generic) + +instance FromJSON Task where + parseJSON :: Value -> Parser Task + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = L.drop 1} + +instance ToJSON Task where + toJSON :: Task -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1} + +-- | Lenses for Task +taskId :: Getter Task TaskId +taskId = to (\(Task {_id = x}) -> x) +{-# INLINE taskId #-} + +taskContent :: Getter Task Content +taskContent = to (\(Task {_content = x}) -> x) +{-# INLINE taskContent #-} + +taskDescription :: Getter Task Description +taskDescription = to (\(Task {_description = x}) -> x) +{-# INLINE taskDescription #-} + +taskProjectId :: Getter Task ProjectId +taskProjectId = to (\(Task {_project_id = x}) -> x) +{-# INLINE taskProjectId #-} + +taskSectionId :: Getter Task (Maybe SectionId) +taskSectionId = to (\(Task {_section_id = x}) -> x) +{-# INLINE taskSectionId #-} + +taskParentId :: Getter Task (Maybe ParentId) +taskParentId = to (\(Task {_parent_id = x}) -> x) +{-# INLINE taskParentId #-} + +taskLabels :: Getter Task [Text] +taskLabels = to (\(Task {_labels = x}) -> x) +{-# INLINE taskLabels #-} + +taskPriority :: Getter Task Int +taskPriority = to (\(Task {_priority = x}) -> x) +{-# INLINE taskPriority #-} + +taskDue :: Getter Task (Maybe Due) +taskDue = to (\(Task {_due = x}) -> x) +{-# INLINE taskDue #-} + +taskDeadline :: Getter Task (Maybe Deadline) +taskDeadline = to (\(Task {_deadline = x}) -> x) +{-# INLINE taskDeadline #-} + +taskDuration :: Getter Task (Maybe Duration) +taskDuration = to (\(Task {_duration = x}) -> x) +{-# INLINE taskDuration #-} + +taskIsCollapsed :: Getter Task IsCollapsed +taskIsCollapsed = to (\(Task {_is_collapsed = x}) -> x) +{-# INLINE taskIsCollapsed #-} + +taskOrder :: Getter Task Order +taskOrder = to (\(Task {_order = x}) -> x) +{-# INLINE taskOrder #-} + +taskAssigneeId :: Getter Task (Maybe Uid) +taskAssigneeId = to (\(Task {_assignee_id = x}) -> x) +{-# INLINE taskAssigneeId #-} + +taskAssignerId :: Getter Task (Maybe Uid) +taskAssignerId = to (\(Task {_assigner_id = x}) -> x) +{-# INLINE taskAssignerId #-} + +taskCompletedAt :: Getter Task (Maybe Text) +taskCompletedAt = to (\(Task {_completed_at = x}) -> x) +{-# INLINE taskCompletedAt #-} + +taskCreatorId :: Getter Task Uid +taskCreatorId = to (\(Task {_creator_id = x}) -> x) +{-# INLINE taskCreatorId #-} + +taskCreatedAt :: Getter Task Text +taskCreatedAt = to (\(Task {_created_at = x}) -> x) +{-# INLINE taskCreatedAt #-} + +taskUpdatedAt :: Getter Task Text +taskUpdatedAt = to (\(Task {_updated_at = x}) -> x) +{-# INLINE taskUpdatedAt #-} + +data NewTask = NewTask + { _user_id :: Text + , _id :: TaskId + , _project_id :: ProjectId + , _section_id :: Maybe SectionId + , _parent_id :: Maybe ParentId + , _added_by_uid :: Maybe Uid + , _assigned_by_uid :: Maybe Uid + , _responsible_uid :: Maybe Uid + , _labels :: [Text] + , _checked :: Bool + , _is_deleted :: Bool + , _added_at :: Maybe Text + , _completed_at :: Maybe Text + , _updated_at :: Maybe Text + , _priority :: Int + , _child_order :: Order + , _content :: Content + , _description :: Description + , _note_count :: Int + , _day_order :: Order + , _is_collapsed :: IsCollapsed + } + deriving (Show, Generic) + +instance FromJSON NewTask where + parseJSON :: Value -> Parser NewTask + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = L.drop 1} + +instance ToJSON NewTask where + toJSON :: NewTask -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1} + +-- | Lenses for NewTask +newTaskUserId :: Getter NewTask Text +newTaskUserId = to (\(NewTask {_user_id = x}) -> x) +{-# INLINE newTaskUserId #-} + +newTaskId :: Getter NewTask TaskId +newTaskId = to (\(NewTask {_id = x}) -> x) +{-# INLINE newTaskId #-} + +newTaskProjectId :: Getter NewTask ProjectId +newTaskProjectId = to (\(NewTask {_project_id = x}) -> x) +{-# INLINE newTaskProjectId #-} + +newTaskSectionId :: Getter NewTask (Maybe SectionId) +newTaskSectionId = to (\(NewTask {_section_id = x}) -> x) +{-# INLINE newTaskSectionId #-} + +newTaskParentId :: Getter NewTask (Maybe ParentId) +newTaskParentId = to (\(NewTask {_parent_id = x}) -> x) +{-# INLINE newTaskParentId #-} + +newTaskAddedByUid :: Getter NewTask (Maybe Uid) +newTaskAddedByUid = to (\(NewTask {_added_by_uid = x}) -> x) +{-# INLINE newTaskAddedByUid #-} + +newTaskAssignedByUid :: Getter NewTask (Maybe Uid) +newTaskAssignedByUid = to (\(NewTask {_assigned_by_uid = x}) -> x) +{-# INLINE newTaskAssignedByUid #-} + +newTaskResponsibleUid :: Getter NewTask (Maybe Uid) +newTaskResponsibleUid = to (\(NewTask {_responsible_uid = x}) -> x) +{-# INLINE newTaskResponsibleUid #-} + +newTaskLabels :: Getter NewTask [Text] +newTaskLabels = to (\(NewTask {_labels = x}) -> x) +{-# INLINE newTaskLabels #-} + +newTaskChecked :: Getter NewTask Bool +newTaskChecked = to (\(NewTask {_checked = x}) -> x) +{-# INLINE newTaskChecked #-} + +newTaskIsDeleted :: Getter NewTask Bool +newTaskIsDeleted = to (\(NewTask {_is_deleted = x}) -> x) +{-# INLINE newTaskIsDeleted #-} + +newTaskAddedAt :: Getter NewTask (Maybe Text) +newTaskAddedAt = to (\(NewTask {_added_at = x}) -> x) +{-# INLINE newTaskAddedAt #-} + +newTaskCompletedAt :: Getter NewTask (Maybe Text) +newTaskCompletedAt = to (\(NewTask {_completed_at = x}) -> x) +{-# INLINE newTaskCompletedAt #-} + +newTaskUpdatedAt :: Getter NewTask (Maybe Text) +newTaskUpdatedAt = to (\(NewTask {_updated_at = x}) -> x) +{-# INLINE newTaskUpdatedAt #-} + +newTaskPriority :: Getter NewTask Int +newTaskPriority = to (\(NewTask {_priority = x}) -> x) +{-# INLINE newTaskPriority #-} + +newTaskChildOrder :: Getter NewTask Order +newTaskChildOrder = to (\(NewTask {_child_order = x}) -> x) +{-# INLINE newTaskChildOrder #-} + +newTaskContent :: Getter NewTask Content +newTaskContent = to (\(NewTask {_content = x}) -> x) +{-# INLINE newTaskContent #-} + +newTaskDescription :: Getter NewTask Description +newTaskDescription = to (\(NewTask {_description = x}) -> x) +{-# INLINE newTaskDescription #-} + +newTaskNoteCount :: Getter NewTask Int +newTaskNoteCount = to (\(NewTask {_note_count = x}) -> x) +{-# INLINE newTaskNoteCount #-} + +newTaskDayOrder :: Getter NewTask Order +newTaskDayOrder = to (\(NewTask {_day_order = x}) -> x) +{-# INLINE newTaskDayOrder #-} + +newTaskIsCollapsed :: Getter NewTask IsCollapsed +newTaskIsCollapsed = to (\(NewTask {_is_collapsed = x}) -> x) +{-# INLINE newTaskIsCollapsed #-} + +data MoveTask = MoveTask + { _project_id :: Maybe ProjectId + , _section_id :: Maybe SectionId + , _parent_id :: Maybe ParentId + } + deriving (Show, Generic) + +instance ToJSON MoveTask where + toJSON :: MoveTask -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1} + +instance FromJSON MoveTask where + parseJSON :: Value -> Parser MoveTask + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = L.drop 1} + +-- | Lenses for MoveTask +moveTaskProjectId :: Getter MoveTask (Maybe ProjectId) +moveTaskProjectId = to (\(MoveTask {_project_id = x}) -> x) +{-# INLINE moveTaskProjectId #-} + +moveTaskSectionId :: Getter MoveTask (Maybe SectionId) +moveTaskSectionId = to (\(MoveTask {_section_id = x}) -> x) +{-# INLINE moveTaskSectionId #-} + +moveTaskParentId :: Getter MoveTask (Maybe ParentId) +moveTaskParentId = to (\(MoveTask {_parent_id = x}) -> x) +{-# INLINE moveTaskParentId #-} + +-- | Create empty MoveTask for use with builder pattern +moveTaskBuilder :: Initial MoveTask +moveTaskBuilder = + seed + MoveTask + { _project_id = Nothing + , _section_id = Nothing + , _parent_id = Nothing + } + +instance HasProjectId MoveTask where + hasProjectId :: Text -> MoveTask -> MoveTask + hasProjectId projId MoveTask {..} = MoveTask {_project_id = Just (ProjectId projId), ..} + +instance HasSectionId MoveTask where + hasSectionId :: Text -> MoveTask -> MoveTask + hasSectionId secId MoveTask {..} = MoveTask {_section_id = Just (SectionId {_id = secId}), ..} + +instance HasParentId MoveTask where + hasParentId :: Text -> MoveTask -> MoveTask + hasParentId parId MoveTask {..} = MoveTask {_parent_id = Just (ParentId parId), ..} + +data AddTaskQuick = AddTaskQuick + { _text :: Text + , _note :: Maybe Text + , _reminder :: Maybe Text + , _auto_reminder :: Bool + , _meta :: Bool + } + deriving (Show, Generic, FromJSON, ToJSON) + +-- | Lenses for AddTaskQuick +addTaskQuickTextLens :: Getter AddTaskQuick Text +addTaskQuickTextLens = to (\(AddTaskQuick {_text = x}) -> x) +{-# INLINE addTaskQuickTextLens #-} + +addTaskQuickNote :: Getter AddTaskQuick (Maybe Text) +addTaskQuickNote = to (\(AddTaskQuick {_note = x}) -> x) +{-# INLINE addTaskQuickNote #-} + +addTaskQuickReminder :: Getter AddTaskQuick (Maybe Text) +addTaskQuickReminder = to (\(AddTaskQuick {_reminder = x}) -> x) +{-# INLINE addTaskQuickReminder #-} + +addTaskQuickAutoReminder :: Getter AddTaskQuick Bool +addTaskQuickAutoReminder = to (\(AddTaskQuick {_auto_reminder = x}) -> x) +{-# INLINE addTaskQuickAutoReminder #-} + +addTaskQuickMeta :: Getter AddTaskQuick Bool +addTaskQuickMeta = to (\(AddTaskQuick {_meta = x}) -> x) +{-# INLINE addTaskQuickMeta #-} + +addTaskQuickText :: Text -> AddTaskQuick +addTaskQuickText text = + AddTaskQuick + { _text = text + , _note = Nothing + , _reminder = Nothing + , _auto_reminder = False + , _meta = False + } + +{- | Request body for creating a new task + +Only content is required. Use 'newTaskBuilder' with the builder pattern for +ergonomic construction of tasks with optional fields. +-} +data TaskCreate = TaskCreate + { _content :: Content + , _description :: Maybe Description + , _project_id :: Maybe ProjectId + , _section_id :: Maybe SectionId + , _parent_id :: Maybe ParentId + , _order :: Maybe Order + , _labels :: Maybe [Text] + , _priority :: Maybe Int + , _assignee_id :: Maybe Int + , _due_string :: Maybe Text + , _due_date :: Maybe Text + , _due_datetime :: Maybe Text + , _due_lang :: Maybe Text + , _duration :: Maybe Int + , _duration_unit :: Maybe Text + , _deadline_date :: Maybe Text + } + deriving (Show, Generic) + +instance ToJSON TaskCreate where + toJSON :: TaskCreate -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1, omitNothingFields = True} + +-- | Create new TaskCreate with required content parameter +newTaskBuilder :: Text -> Initial TaskCreate +newTaskBuilder content = + seed + TaskCreate + { _content = Content content + , _description = Nothing + , _project_id = Nothing + , _section_id = Nothing + , _parent_id = Nothing + , _order = Nothing + , _labels = Nothing + , _priority = Nothing + , _assignee_id = Nothing + , _due_string = Nothing + , _due_date = Nothing + , _due_datetime = Nothing + , _due_lang = Nothing + , _duration = Nothing + , _duration_unit = Nothing + , _deadline_date = Nothing + } + +instance HasDescription TaskCreate where + hasDescription :: Text -> TaskCreate -> TaskCreate + hasDescription desc TaskCreate {..} = TaskCreate {_description = Just (Description desc), ..} + +instance HasContent TaskCreate where + hasContent :: Text -> TaskCreate -> TaskCreate + hasContent content TaskCreate {..} = TaskCreate {_content = Content content, ..} + +instance HasSectionId TaskCreate where + hasSectionId :: Text -> TaskCreate -> TaskCreate + hasSectionId sid TaskCreate {..} = TaskCreate {_section_id = Just (SectionId {_id = sid}), ..} + +instance HasParentId TaskCreate where + hasParentId :: Text -> TaskCreate -> TaskCreate + hasParentId pid TaskCreate {..} = TaskCreate {_parent_id = Just (ParentId pid), ..} + +instance HasOrder TaskCreate where + hasOrder :: Int -> TaskCreate -> TaskCreate + hasOrder order TaskCreate {..} = TaskCreate {_order = Just (Order order), ..} + +instance HasLabels TaskCreate where + hasLabels :: [Text] -> TaskCreate -> TaskCreate + hasLabels labels TaskCreate {..} = TaskCreate {_labels = Just labels, ..} + +instance HasPriority TaskCreate where + hasPriority :: Int -> TaskCreate -> TaskCreate + hasPriority priority TaskCreate {..} = TaskCreate {_priority = Just priority, ..} + +instance HasAssigneeId TaskCreate where + hasAssigneeId :: Int -> TaskCreate -> TaskCreate + hasAssigneeId aid TaskCreate {..} = TaskCreate {_assignee_id = Just aid, ..} + +instance HasDueString TaskCreate where + hasDueString :: Text -> TaskCreate -> TaskCreate + hasDueString dueStr TaskCreate {..} = TaskCreate {_due_string = Just dueStr, ..} + +instance HasDueDate TaskCreate where + hasDueDate :: Text -> TaskCreate -> TaskCreate + hasDueDate dueDate TaskCreate {..} = TaskCreate {_due_date = Just dueDate, ..} + +instance HasDueDatetime TaskCreate where + hasDueDatetime :: Text -> TaskCreate -> TaskCreate + hasDueDatetime dueDatetime TaskCreate {..} = TaskCreate {_due_datetime = Just dueDatetime, ..} + +instance HasDueLang TaskCreate where + hasDueLang :: Text -> TaskCreate -> TaskCreate + hasDueLang dueLang TaskCreate {..} = TaskCreate {_due_lang = Just dueLang, ..} + +instance HasDuration TaskCreate where + hasDuration :: Int -> TaskCreate -> TaskCreate + hasDuration duration TaskCreate {..} = TaskCreate {_duration = Just duration, ..} + +instance HasDurationUnit TaskCreate where + hasDurationUnit :: Text -> TaskCreate -> TaskCreate + hasDurationUnit durationUnit TaskCreate {..} = TaskCreate {_duration_unit = Just durationUnit, ..} + +instance HasDeadlineDate TaskCreate where + hasDeadlineDate :: Text -> TaskCreate -> TaskCreate + hasDeadlineDate deadlineDate TaskCreate {..} = TaskCreate {_deadline_date = Just deadlineDate, ..} + +instance HasProjectId TaskCreate where + hasProjectId :: Text -> TaskCreate -> TaskCreate + hasProjectId projId TaskCreate {..} = TaskCreate {_project_id = Just (ProjectId projId), ..} + +{- | Request body for updating an existing task (partial updates) + +All fields are optional (using Maybe). Only provided fields will be updated. +Use 'updateTaskBuilder' with the builder pattern for updates. +-} +data TaskUpdate = TaskUpdate + { _content :: Maybe Content + , _description :: Maybe Description + , _labels :: Maybe [Text] + , _priority :: Maybe Int + , _due_string :: Maybe Text + , _due_date :: Maybe Text + , _due_datetime :: Maybe Text + , _due_lang :: Maybe Text + , _assignee_id :: Maybe Int + , _duration :: Maybe Int + , _duration_unit :: Maybe Text + , _deadline_date :: Maybe Text + , _deadline_lang :: Maybe Text + } + deriving (Show, Generic) + +updateTaskBuilder :: Initial TaskUpdate +updateTaskBuilder = + seed + TaskUpdate + { _content = Nothing + , _description = Nothing + , _labels = Nothing + , _priority = Nothing + , _due_string = Nothing + , _due_date = Nothing + , _due_datetime = Nothing + , _due_lang = Nothing + , _assignee_id = Nothing + , _duration = Nothing + , _duration_unit = Nothing + , _deadline_date = Nothing + , _deadline_lang = Nothing + } + +instance ToJSON TaskUpdate where + toJSON :: TaskUpdate -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1, omitNothingFields = True} + +instance HasDescription TaskUpdate where + hasDescription :: Text -> TaskUpdate -> TaskUpdate + hasDescription desc TaskUpdate {..} = TaskUpdate {_description = Just (Description desc), ..} + +instance HasContent TaskUpdate where + hasContent :: Text -> TaskUpdate -> TaskUpdate + hasContent content TaskUpdate {..} = TaskUpdate {_content = Just (Content content), ..} + +instance HasLabels TaskUpdate where + hasLabels :: [Text] -> TaskUpdate -> TaskUpdate + hasLabels labels TaskUpdate {..} = TaskUpdate {_labels = Just labels, ..} + +instance HasPriority TaskUpdate where + hasPriority :: Int -> TaskUpdate -> TaskUpdate + hasPriority priority TaskUpdate {..} = TaskUpdate {_priority = Just priority, ..} + +instance HasDueString TaskUpdate where + hasDueString :: Text -> TaskUpdate -> TaskUpdate + hasDueString dueStr TaskUpdate {..} = TaskUpdate {_due_string = Just dueStr, ..} + +instance HasDueDate TaskUpdate where + hasDueDate :: Text -> TaskUpdate -> TaskUpdate + hasDueDate dueDate TaskUpdate {..} = TaskUpdate {_due_date = Just dueDate, ..} + +instance HasDueDatetime TaskUpdate where + hasDueDatetime :: Text -> TaskUpdate -> TaskUpdate + hasDueDatetime dueDatetime TaskUpdate {..} = TaskUpdate {_due_datetime = Just dueDatetime, ..} + +instance HasDueLang TaskUpdate where + hasDueLang :: Text -> TaskUpdate -> TaskUpdate + hasDueLang dueLang TaskUpdate {..} = TaskUpdate {_due_lang = Just dueLang, ..} + +instance HasAssigneeId TaskUpdate where + hasAssigneeId :: Int -> TaskUpdate -> TaskUpdate + hasAssigneeId aid TaskUpdate {..} = TaskUpdate {_assignee_id = Just aid, ..} + +instance HasDuration TaskUpdate where + hasDuration :: Int -> TaskUpdate -> TaskUpdate + hasDuration duration TaskUpdate {..} = TaskUpdate {_duration = Just duration, ..} + +instance HasDurationUnit TaskUpdate where + hasDurationUnit :: Text -> TaskUpdate -> TaskUpdate + hasDurationUnit durationUnit TaskUpdate {..} = TaskUpdate {_duration_unit = Just durationUnit, ..} + +instance HasDeadlineDate TaskUpdate where + hasDeadlineDate :: Text -> TaskUpdate -> TaskUpdate + hasDeadlineDate deadlineDate TaskUpdate {..} = TaskUpdate {_deadline_date = Just deadlineDate, ..} + +{- | Internal type for parsing completed tasks API response +The API returns full task objects, not just IDs +-} +newtype CompletedTasksQueryParamAPI = CompletedTasksQueryParamAPI + { items :: [TaskCompletedItem] + } + deriving (Show, Generic, FromJSON) + +{- | Minimal task representation for completed tasks response +Only contains the id field we need from the completed tasks API +-} +newtype TaskCompletedItem = TaskCompletedItem + { id :: Text + } + deriving (Show, Generic, FromJSON) + +class (Monad m) => TodoistTaskM m where + -- | Get tasks (automatically fetches all pages) + getTasks :: TaskParam -> m [Task] + + -- | Get a single task by ID + getTask :: TaskId -> m Task + + -- | Create a new task + createTask :: TaskCreate -> m NewTask -- todo: should return Task; TaskCreate should be named NewTask + + -- | Update an existing task with partial changes + updateTask :: TaskUpdate -> TaskId -> m NewTask -- todo: should return Task + + -- | Mark a task as completed + closeTask :: TaskId -> m () + + -- | Reopen a previously completed task + uncloseTask :: TaskId -> m () + + -- | Permanently delete a task + deleteTask :: TaskId -> m () + + -- | Get tasks by filter (automatically fetches all pages) + getTasksByFilter :: TaskFilter -> m [TaskId] + + -- | Move a task to a different project or section + moveTask :: MoveTask -> TaskId -> m TaskId + + addTaskQuick :: AddTaskQuick -> m () + + getCompletedTasksByDueDate :: CompletedTasksQueryParam -> m [TaskId] + + getCompletedTasksByCompletionDate :: CompletedTasksQueryParam -> m [TaskId] + + {- | Get tasks with manual pagination control + Returns a tuple of (results, next_cursor) for the requested page + -} + getTasksPaginated :: TaskParam -> m ([TaskId], Maybe Text) + + {- | Get tasks by filter with manual pagination control + Returns a tuple of (results, next_cursor) for the requested page + Note: TaskFilter already has cursor and limit fields + -} + getTasksByFilterPaginated :: TaskFilter -> m ([TaskId], Maybe Text) + + -- | Get all tasks with custom page size (fetches all pages automatically) + getTasksWithLimit :: Int -> TaskParam -> m [TaskId] + + -- | Get all tasks by filter with custom page size (fetches all pages automatically) + getTasksByFilterWithLimit :: TaskFilter -> Int -> m [TaskId] + +-- | Query parameters for filtering tasks +data TaskParam = TaskParam + { project_id :: Maybe Text + , section_id :: Maybe Text + , parent_id :: Maybe Text + , task_ids :: [Text] + , cursor :: Maybe Text + , limit :: Maybe Int + } + deriving (Show) + +instance QueryParam TaskParam where + toQueryParam :: TaskParam -> Params + toQueryParam TaskParam {..} = + maybe [] (\projId -> [("project_id", projId)]) project_id + <> maybe [] (\secId -> [("section_id", secId)]) section_id + <> maybe [] (\parId -> [("parent_id", parId)]) parent_id + <> L.map ("task_id",) task_ids + <> maybe [] (\c -> [("cursor", c)]) cursor + <> maybe [] (\l -> [("limit", Data.Text.show l)]) limit + +-- | Query parameters for filtering tasks by text query +data TaskFilter = TaskFilter + { query :: Text + , lang :: Maybe Text + , cursor :: Maybe Text + , limit :: Maybe Int + } + deriving (Show) + +instance QueryParam TaskFilter where + toQueryParam :: TaskFilter -> Params + toQueryParam TaskFilter {..} = + [("query", query)] + <> maybe [] (\p -> [("lang", p)]) lang + <> maybe [] (\p -> [("cursor", p)]) cursor + <> maybe [] (\p -> [("limit", Data.Text.show p)]) limit + +-- | Create new TaskFilter with required query parameter +filterTaskBuilder :: Text -> Initial TaskFilter +filterTaskBuilder query = + seed + TaskFilter + { query + , lang = Nothing + , cursor = Nothing + , limit = Nothing + } + +-- | Query parameters for getting completed tasks +data CompletedTasksQueryParam = CompletedTasksQueryParam + { since :: Text + , until :: Text + , workspace_id :: Maybe Text + , project_id :: Maybe Text + , section_id :: Maybe Text + , parent_id :: Maybe Text + , filter_query :: Maybe Text + , filter_lang :: Maybe Text + , cursor :: Maybe Text + , limit :: Int + } + deriving (Show) + +instance QueryParam CompletedTasksQueryParam where + toQueryParam :: CompletedTasksQueryParam -> Params + toQueryParam CompletedTasksQueryParam {..} = + [("since", since)] + <> [("until", until)] + <> maybe [] (\p -> [("workspace_id", p)]) workspace_id + <> maybe [] (\p -> [("project_id", p)]) project_id + <> maybe [] (\p -> [("section_id", p)]) section_id + <> maybe [] (\p -> [("parent_id", p)]) parent_id + <> maybe [] (\p -> [("filter_query", p)]) filter_query + <> maybe [] (\p -> [("filter_lang", p)]) filter_lang + <> maybe [] (\p -> [("cursor", p)]) cursor + <> [("limit", Data.Text.show limit)] + +-- | Create new CompletedTasksQueryParam with required since/until parameters +completedTasksQueryParamBuilder :: Text -> Text -> Initial CompletedTasksQueryParam +completedTasksQueryParamBuilder since until = + seed + CompletedTasksQueryParam + { since + , until + , workspace_id = Nothing + , project_id = Nothing + , section_id = Nothing + , parent_id = Nothing + , filter_query = Nothing + , filter_lang = Nothing + , cursor = Nothing + , limit = 50 + } + +-- | Create empty TaskParam for use with builder pattern +taskParamBuilder :: Initial TaskParam +taskParamBuilder = + seed + TaskParam + { project_id = Nothing + , section_id = Nothing + , parent_id = Nothing + , task_ids = [] + , cursor = Nothing + , limit = Nothing + } + +-- HasX instances for TaskParam +instance HasProjectId TaskParam where + hasProjectId :: Text -> TaskParam -> TaskParam + hasProjectId pid TaskParam {..} = TaskParam {project_id = Just pid, ..} + +instance HasSectionId TaskParam where + hasSectionId :: Text -> TaskParam -> TaskParam + hasSectionId sid TaskParam {..} = TaskParam {section_id = Just sid, ..} + +instance HasParentId TaskParam where + hasParentId :: Text -> TaskParam -> TaskParam + hasParentId pid TaskParam {..} = TaskParam {parent_id = Just pid, ..} + +instance HasTaskIds TaskParam where + hasTaskIds :: [Text] -> TaskParam -> TaskParam + hasTaskIds tids TaskParam {..} = TaskParam {task_ids = tids, ..} + +instance HasCursor TaskParam where + hasCursor :: Text -> TaskParam -> TaskParam + hasCursor c TaskParam {..} = TaskParam {cursor = Just c, ..} + +instance HasLimit TaskParam where + hasLimit :: Int -> TaskParam -> TaskParam + hasLimit l TaskParam {..} = TaskParam {limit = Just l, ..} + +-- HasX instances for TaskFilter +instance HasLang TaskFilter where + hasLang :: Text -> TaskFilter -> TaskFilter + hasLang lng TaskFilter {..} = TaskFilter {lang = Just lng, ..} + +instance HasCursor TaskFilter where + hasCursor :: Text -> TaskFilter -> TaskFilter + hasCursor c TaskFilter {..} = TaskFilter {cursor = Just c, ..} + +instance HasLimit TaskFilter where + hasLimit :: Int -> TaskFilter -> TaskFilter + hasLimit l TaskFilter {..} = TaskFilter {limit = Just l, ..} + +-- HasX instances for CompletedTasksQueryParam +instance HasProjectId CompletedTasksQueryParam where + hasProjectId :: Text -> CompletedTasksQueryParam -> CompletedTasksQueryParam + hasProjectId pid CompletedTasksQueryParam {..} = CompletedTasksQueryParam {project_id = Just pid, ..} + +instance HasSectionId CompletedTasksQueryParam where + hasSectionId :: Text -> CompletedTasksQueryParam -> CompletedTasksQueryParam + hasSectionId sid CompletedTasksQueryParam {..} = CompletedTasksQueryParam {section_id = Just sid, ..} + +instance HasParentId CompletedTasksQueryParam where + hasParentId :: Text -> CompletedTasksQueryParam -> CompletedTasksQueryParam + hasParentId pid CompletedTasksQueryParam {..} = CompletedTasksQueryParam {parent_id = Just pid, ..} + +instance HasFilterQuery CompletedTasksQueryParam where + hasFilterQuery :: Text -> CompletedTasksQueryParam -> CompletedTasksQueryParam + hasFilterQuery fq CompletedTasksQueryParam {..} = CompletedTasksQueryParam {filter_query = Just fq, ..} + +instance HasFilterLang CompletedTasksQueryParam where + hasFilterLang :: Text -> CompletedTasksQueryParam -> CompletedTasksQueryParam + hasFilterLang fl CompletedTasksQueryParam {..} = CompletedTasksQueryParam {filter_lang = Just fl, ..} + +instance HasCursor CompletedTasksQueryParam where + hasCursor :: Text -> CompletedTasksQueryParam -> CompletedTasksQueryParam + hasCursor c CompletedTasksQueryParam {..} = CompletedTasksQueryParam {cursor = Just c, ..} + +instance HasLimit CompletedTasksQueryParam where + hasLimit :: Int -> CompletedTasksQueryParam -> CompletedTasksQueryParam + hasLimit l CompletedTasksQueryParam {..} = CompletedTasksQueryParam {limit = l, ..} diff --git a/src/Web/Todoist/Domain/Types.hs b/src/Web/Todoist/Domain/Types.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Domain/Types.hs @@ -0,0 +1,256 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE InstanceSigs #-} + +{- | +Module : Web.Todoist.Domain.Types +Description : Shared domain types and type classes +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +This module provides shared types used across the Todoist SDK, including +newtype wrappers for IDs and common fields, as well as core enums and data types. + +Most users will import "Web.Todoist" which re-exports these types rather than +importing this module directly. +-} +module Web.Todoist.Domain.Types + ( Attachment + , ViewStyle (..) + , ProjectId (..) + , TaskId (..) + , Uid (..) + , Name (..) + , Color (..) + , Order (..) + , IsFavorite (..) + , Description (..) + , IsCollapsed (..) + , Content (..) + , ParentId (..) + , parseViewStyle + -- * Lenses + , fileName + , fileType + , fileUrl + , resourceType + ) where + +import Control.Monad (return) +import Data.Aeson + ( FromJSON (..) + , ToJSON (..) + , Value + , defaultOptions + , fieldLabelModifier + , genericParseJSON + , genericToJSON + , withObject + , (.:) + ) +import Data.Aeson.Types (Parser) +import Data.Bool (Bool) +import Data.Eq (Eq) +import Data.Function (($)) +import Data.Functor ((<$>)) +import Data.Int (Int) +import qualified Data.List as L +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Base (undefined) +import GHC.Generics (Generic) +import Lens.Micro (to) +import Text.Show (Show) +import Web.Todoist.Lens (Getter) + +{- | Visual display style for projects + +Projects can be displayed as a list, board (Kanban-style), or calendar view. +-} +data ViewStyle = List | Board | Calendar deriving (Show, Eq) + +instance ToJSON ViewStyle where + toJSON :: ViewStyle -> Value + toJSON List = toJSON ("list" :: Text) + toJSON Board = toJSON ("board" :: Text) + toJSON Calendar = toJSON ("calendar" :: Text) + +instance FromJSON ViewStyle where + parseJSON :: Value -> Parser ViewStyle + parseJSON v = do + str <- parseJSON v + return $ parseViewStyle str + +-- | Parse a Text string into ViewStyle, defaulting to undefined for unrecognized values +parseViewStyle :: Text -> ViewStyle +parseViewStyle txt = case T.toLower txt of + "list" -> List + "board" -> Board + "calendar" -> Calendar + _ -> undefined -- Default to undefined for unrecognized values + +-- | Attachment metadata for comment +data Attachment = Attachment + { _resource_type :: Text + , _file_name :: Text + , _file_type :: Text + , _file_url :: Text + } + deriving (Show, Eq, Generic) + +instance ToJSON Attachment where + toJSON :: Attachment -> Value + toJSON = genericToJSON defaultOptions {fieldLabelModifier = L.drop 1} + +instance FromJSON Attachment where + parseJSON :: Value -> Parser Attachment + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = L.drop 1} + +-- | Lenses for Attachment +fileName :: Getter Attachment Text +fileName = to _file_name +{-# INLINE fileName #-} + +fileType :: Getter Attachment Text +fileType = to _file_type +{-# INLINE fileType #-} + +fileUrl :: Getter Attachment Text +fileUrl = to _file_url +{-# INLINE fileUrl #-} + +resourceType :: Getter Attachment Text +resourceType = to _resource_type +{-# INLINE resourceType #-} + +-- | Unique identifier for a Todoist project +newtype ProjectId = ProjectId + { getProjectId :: Text + } + deriving (Show, Eq, Generic) + +-- Custom JSON instances for ProjectId - parse from {"id": "..."} object +instance FromJSON ProjectId where + parseJSON :: Value -> Parser ProjectId + parseJSON = withObject "ProjectId" $ \obj -> + ProjectId <$> obj .: "id" + +instance ToJSON ProjectId where + toJSON :: ProjectId -> Value + toJSON (ProjectId txt) = toJSON txt + +-- | Unique identifier for a Todoist task +newtype TaskId = TaskId + { getTaskId :: Text + } + deriving (Show, Eq, Generic) + +instance FromJSON TaskId where + parseJSON :: Value -> Parser TaskId + parseJSON v = TaskId <$> parseJSON v + +instance ToJSON TaskId where + toJSON :: TaskId -> Value + toJSON (TaskId txt) = toJSON txt + +-- | User ID in Todoist system +newtype Uid = Uid {getUid :: Text} deriving (Show, Eq, Generic) + +instance FromJSON Uid where + parseJSON :: Value -> Parser Uid + parseJSON v = Uid <$> parseJSON v + +instance ToJSON Uid where + toJSON :: Uid -> Value + toJSON (Uid txt) = toJSON txt + +-- | Display name for projects, tasks, or other entities +newtype Name = Name {getName :: Text} deriving (Show, Eq, Generic) + +instance FromJSON Name where + parseJSON :: Value -> Parser Name + parseJSON v = Name <$> parseJSON v + +instance ToJSON Name where + toJSON :: Name -> Value + toJSON (Name txt) = toJSON txt + +-- | Color identifier for visual categorization (e.g., \"red\", \"blue\", \"green\") +newtype Color = Color {getColor :: Text} deriving (Show, Eq, Generic) + +instance FromJSON Color where + parseJSON :: Value -> Parser Color + parseJSON v = Color <$> parseJSON v + +instance ToJSON Color where + toJSON :: Color -> Value + toJSON (Color txt) = toJSON txt + +-- | Sort order for items (lower numbers appear first) +newtype Order = Order {getOrder :: Int} deriving (Show, Eq, Generic) + +instance FromJSON Order where + parseJSON :: Value -> Parser Order + parseJSON v = Order <$> parseJSON v + +instance ToJSON Order where + toJSON :: Order -> Value + toJSON (Order txt) = toJSON txt + +-- | Flag indicating whether an item is marked as favorite +newtype IsFavorite = IsFavorite {getIsFavorite :: Bool} deriving (Show, Eq, Generic) + +instance FromJSON IsFavorite where + parseJSON :: Value -> Parser IsFavorite + parseJSON v = IsFavorite <$> parseJSON v + +instance ToJSON IsFavorite where + toJSON :: IsFavorite -> Value + toJSON (IsFavorite txt) = toJSON txt + +-- | Markdown-formatted description text +newtype Description = Description {getDescription :: Text} deriving (Show, Eq, Generic) + +instance FromJSON Description where + parseJSON :: Value -> Parser Description + parseJSON v = Description <$> parseJSON v + +instance ToJSON Description where + toJSON :: Description -> Value + toJSON (Description txt) = toJSON txt + +-- | Flag indicating whether a section or project is collapsed in the UI +newtype IsCollapsed = IsCollapsed {getIsCollapsed :: Bool} deriving (Show, Eq, Generic) + +instance FromJSON IsCollapsed where + parseJSON :: Value -> Parser IsCollapsed + parseJSON v = IsCollapsed <$> parseJSON v + +instance ToJSON IsCollapsed where + toJSON :: IsCollapsed -> Value + toJSON (IsCollapsed txt) = toJSON txt + +-- | Task or comment content text +newtype Content = Content {getContent :: Text} deriving (Show, Eq, Generic) + +instance ToJSON Content where + toJSON :: Content -> Value + toJSON (Content txt) = toJSON txt + +instance FromJSON Content where + parseJSON :: Value -> Parser Content + parseJSON v = Content <$> parseJSON v + +-- | Parent project or task identifier for hierarchical relationships +newtype ParentId = ParentId + { getParentId :: Text + } + deriving (Show, Eq, Generic) + +instance FromJSON ParentId where + parseJSON :: Value -> Parser ParentId + parseJSON v = ParentId <$> parseJSON v + +instance ToJSON ParentId where + toJSON :: ParentId -> Value + toJSON (ParentId txt) = toJSON txt diff --git a/src/Web/Todoist/Lens.hs b/src/Web/Todoist/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Lens.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} + +{- | +Module: Web.Todoist.Lens +Description: Getter-only lenses for TodoistSDK types + +This module re-exports the @microlens@ operators needed for read-only field access. +All lenses in TodoistSDK are getter-only - they provide read access but no setters. + +For field mutations, use the builder pattern (@Web.Todoist.Util.Builder@). + +Example usage: +@ +import Web.Todoist +import Web.Todoist.Lens ((^.)) + +-- Extract field from Project +let projectName = myProject ^. name + +-- Compose getters for nested access +let dueDateValue = myTask ^. due . date +@ +-} +module Web.Todoist.Lens + ( -- * Getter Types + Getter + , Getting + -- * Operators + , (^.) + , to + ) where + +import Lens.Micro (Getting, to, (^.)) + +-- | A 'Getter' is a read-only lens +type Getter s a = forall r. Getting r s a diff --git a/src/Web/Todoist/Runner.hs b/src/Web/Todoist/Runner.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Runner.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +{- | +Module : Web.Todoist.Runner +Description : Entry points for executing Todoist operations +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +This module provides the main entry points for executing Todoist operations. +It defines the 'TodoistRunner' type class and provides convenience functions +for running operations with different interpreters. + += Usage Example + +@ +import Web.Todoist.Runner +import Web.Todoist.Domain.Project + +main :: IO () +main = do + let config = newTodoistConfig "your-api-token" + result <- todoist config getAllProjects + case result of + Left err -> print err + Right projects -> print projects +@ +-} +module Web.Todoist.Runner + ( todoist + , newTodoistConfig + , todoistTraceRunner + , runTodoistWith + , MonadTodoist + ) where + +import Web.Todoist.Domain.Comment (TodoistCommentM) +import Web.Todoist.Domain.Label (TodoistLabelM) +import Web.Todoist.Domain.Project (TodoistProjectM) +import Web.Todoist.Domain.Section (TodoistSectionM) +import Web.Todoist.Domain.Task (TodoistTaskM) +import Web.Todoist.Internal.Config (Token (..)) +import Web.Todoist.Internal.Error (TodoistError) +import Web.Todoist.Runner.IO + ( TodoistConfig (..) + , TodoistIO (unTodoist) + ) +import Web.Todoist.Runner.Trace (Op, Trace (runTrace)) + +import Control.Applicative (Applicative (pure)) +import Control.Monad.Trans.Except (runExceptT) +import Control.Monad.Trans.Reader (ReaderT (runReaderT)) +import Control.Monad.Trans.Writer (execWriter) +import Data.Either (Either) +import Data.Function ((.)) +import Data.Text (Text) +import System.IO (IO) + +{- | Create a new Todoist configuration with an API token + +The token can be obtained from Todoist Settings → Integrations → Developer. +This configuration is used to authenticate all API requests. + +Example: + +@ +let config = newTodoistConfig "your-api-token-here" +@ +-} +newTodoistConfig :: Text -> TodoistConfig +newTodoistConfig token = TodoistConfig {authToken = Token token} + +{- | Constraint synonym for operations requiring all domain capabilities + +This type alias combines 'TodoistProjectM', 'TodoistTaskM', 'TodoistCommentM', +'TodoistSectionM', and 'TodoistLabelM' constraints, allowing functions to work +with all Todoist resources without listing all individual constraints. +-} +class + (TodoistProjectM m, TodoistTaskM m, TodoistCommentM m, TodoistSectionM m, TodoistLabelM m) => + MonadTodoist m +instance + (TodoistProjectM m, TodoistTaskM m, TodoistCommentM m, TodoistSectionM m, TodoistLabelM m) => + MonadTodoist m + +{- | Execute Todoist operations using the TodoistIO interpreter + +This is the primary function for making real HTTP requests to the Todoist API. +It handles authentication, error handling, and returns results in an Either type. + +Example: + +@ +result <- todoist config getAllProjects +case result of + Left err -> putStrLn $ "Error: " ++ show err + Right projects -> mapM_ print projects +@ +-} +todoist :: TodoistConfig -> TodoistIO a -> IO (Either TodoistError a) +todoist env operations = runExceptT (runReaderT (unTodoist operations) env) + +{- | Execute operations with the Trace interpreter for testing + +The Trace interpreter records operations without executing them, useful for +testing and debugging. Returns a list of recorded operations. + +Example: + +@ +ops <- todoistTraceRunner config getAllProjects +print ops -- [GetAllProjects] +@ +-} +todoistTraceRunner :: TodoistConfig -> Trace a -> IO (Either TodoistError [Op]) +todoistTraceRunner _ = pure . pure . execWriter . runTrace + +{- | Type class for running operations with different interpreters + +This class allows you to run Todoist operations with any interpreter +that implements the required type class methods. The 'Output' type family +determines what type of result is returned. + +Use 'runTodoistWith' for custom interpreters or when you need explicit +interpreter selection. +-} +class (MonadTodoist r) => TodoistRunner r where + type Output r a -- Associated Type Families + + {- | Execute operations with a custom interpreter + + This function allows you to run operations with any interpreter that implements + 'TodoistRunner'. Use this for testing with the Trace interpreter or implementing + custom interpreters. + + Example with Trace: + + @ + ops <- runTodoistWith config (getAllProjects :: Trace [Project]) + print ops -- Shows recorded operations without executing them + @ + -} + runTodoistWith :: TodoistConfig -> r a -> IO (Either TodoistError (Output r a)) + +instance TodoistRunner TodoistIO where + type Output TodoistIO a = a + + runTodoistWith :: TodoistConfig -> TodoistIO a -> IO (Either TodoistError a) + runTodoistWith = todoist + +instance TodoistRunner Trace where + type Output Trace a = [Op] + + runTodoistWith :: TodoistConfig -> Trace a -> IO (Either TodoistError [Op]) + runTodoistWith = todoistTraceRunner diff --git a/src/Web/Todoist/Runner/IO.hs b/src/Web/Todoist/Runner/IO.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Runner/IO.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE DerivingStrategies #-} + +-- | Main IO module - re-exports the TodoistIO type and brings instances into scope +module Web.Todoist.Runner.IO + ( TodoistConfig (..) + , TodoistIO (..) + ) where + +import Web.Todoist.Internal.Config (TodoistConfig (..)) + +-- Re-export TodoistIO from Core +import Web.Todoist.Runner.IO.Core (TodoistIO (..)) + +-- Import Interpreters module to bring all instances into scope +import Web.Todoist.Runner.IO.Interpreters () diff --git a/src/Web/Todoist/Runner/IO/Core.hs b/src/Web/Todoist/Runner/IO/Core.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Runner/IO/Core.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +{- | +Module : Web.Todoist.Runner.IO.Core +Description : TodoistIO monad definition and core types +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +This module defines the 'TodoistIO' monad used for executing real HTTP requests +to the Todoist API. Most users will use the 'todoist' function from +"Web.Todoist.Runner" rather than working with this monad directly. + +The TodoistIO monad is implemented as a ReaderT/ExceptT stack over IO, providing +implicit configuration threading and automatic error handling. +-} +module Web.Todoist.Runner.IO.Core + ( TodoistIO (..) + ) where + +import Web.Todoist.Internal.Config (TodoistConfig) +import Web.Todoist.Internal.Error (TodoistError) + +import Control.Applicative (Applicative) +import Control.Monad (Functor, Monad) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.IO.Class (MonadIO) +import System.IO (IO) + +-- | TodoistIO monad - provides IO-based execution for Todoist operations +newtype TodoistIO a + = TodoistIO {unTodoist :: ReaderT TodoistConfig (ExceptT TodoistError IO) a} + deriving newtype (Functor, Applicative, Monad, MonadIO) diff --git a/src/Web/Todoist/Runner/IO/Interpreters.hs b/src/Web/Todoist/Runner/IO/Interpreters.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Runner/IO/Interpreters.hs @@ -0,0 +1,901 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | TodoistIO interpreter implementations for all domain type classes. +-- This module contains all the orphan instances that implement the domain +-- operations using actual HTTP requests to the Todoist API. +module Web.Todoist.Runner.IO.Interpreters + ( -- * Conversion Functions (for testing) + projectResponseToProject + , commentResponseToComment + ) where + +import Control.Applicative (pure, (<$>)) +import Control.Monad (fmap) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT, except) +import Control.Monad.Trans.Reader (ReaderT, ask) +import Data.Either (Either (Left, Right)) +import Data.Function (($)) +import Data.Int (Int) +import Data.Maybe (Maybe (..), fromMaybe) +import Data.Monoid ((<>)) +import Data.Proxy (Proxy (Proxy)) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Traversable (traverse) +import Data.Void (Void) +import System.IO (IO) + +-- Domain imports +import Web.Todoist.Domain.Comment + ( Comment (..) + , CommentCreate + , CommentId (..) + , CommentParam (..) + , CommentUpdate + , TodoistCommentM (..) + ) +import Web.Todoist.Domain.Label + ( Label (..) + , LabelCreate + , LabelId (..) + , LabelParam (..) + , LabelUpdate + , SharedLabelParam (..) + , SharedLabelRemove + , SharedLabelRename + , TodoistLabelM (..) + ) +import Web.Todoist.Domain.Project + ( CanAssignTasks (..) + , Collaborator + , IsArchived (..) + , IsShared (..) + , PaginationParam (..) + , Project (..) + , ProjectCreate + , ProjectUpdate + , TodoistProjectM (..) + ) +import Web.Todoist.Domain.Section + ( Section (..) + , SectionCreate + , SectionId (..) + , SectionParam (..) + , SectionUpdate + , TodoistSectionM (..) + ) +import Web.Todoist.Domain.Task + ( AddTaskQuick + , CompletedTasksQueryParam + , CompletedTasksQueryParamAPI (items) + , Deadline (..) + , Due (..) + , Duration (..) + , DurationUnit (..) + , MoveTask + , NewTask (..) + , Task (..) + , TaskCompletedItem (..) + , TaskCreate + , TaskFilter (..) + , TaskParam (..) + , TaskUpdate + , TodoistTaskM (..) + ) +import Web.Todoist.Domain.Types + ( Color (..) + , Content (..) + , Description (..) + , IsFavorite (..) + , IsCollapsed (..) + , Name (..) + , Order (..) + , ParentId (..) + , ProjectId (..) + , TaskId (..) + , Uid (..) + , parseViewStyle + ) + +-- Internal imports +import Web.Todoist.Internal.Config (TodoistConfig) +import Web.Todoist.Internal.Error (TodoistError (HttpError)) +import Web.Todoist.Internal.HTTP (PostResponse (..), apiDelete, apiGet, apiPost) +import Web.Todoist.Internal.Request (mkTodoistRequest) +import Web.Todoist.Internal.Types + ( CommentResponse (..) + , CreatedAt (..) + , DeadlineResponse (..) + , DueResponse (..) + , DurationResponse (..) + , LabelResponse (..) + , NewTaskResponse (..) + , ProjectPermissions + , ProjectResponse (..) + , SectionResponse (..) + , TaskResponse (..) + , TodoistReturn (next_cursor, results) + , UpdatedAt (..) + ) + +-- Runner imports +import Web.Todoist.Util.QueryParam (QueryParam (toQueryParam)) +import Web.Todoist.Runner.IO.Core (TodoistIO (..)) + +-- ============================================================================ +-- Conversion Functions (Internal - Not Exported) +-- ============================================================================ + +-- | Convert ProjectResponse to Project +projectResponseToProject :: ProjectResponse -> Project +projectResponseToProject ProjectResponse {..} = + let (CreatedAt createdAt) = p_created_at + (UpdatedAt updatedAt) = p_updated_at + in Project + { _id = ProjectId p_id + , _name = Name p_name + , _description = Description p_description + , _order = Order p_child_order + , _color = Color p_color + , _is_collapsed = IsCollapsed p_is_collapsed + , _is_shared = IsShared p_is_shared + , _is_favorite = IsFavorite p_is_favorite + , _is_archived = IsArchived p_is_archived + , _can_assign_tasks = CanAssignTasks p_can_assign_tasks + , _view_style = parseViewStyle p_view_style + , _created_at = createdAt + , _updated_at = updatedAt + } + +-- | Parse duration unit text to DurationUnit enum +parseDurationUnit :: Text -> DurationUnit +parseDurationUnit txt = case T.toLower txt of + "minute" -> Minute + "day" -> Day + _ -> Day -- Default to Day for unknown units + +-- | Convert DurationResponse to Duration +durationResponseToDuration :: DurationResponse -> Duration +durationResponseToDuration DurationResponse {..} = + Duration + { _amount = p_amount + , _unit = parseDurationUnit p_unit + } + +-- | Convert DeadlineResponse to Deadline +deadlineResponseToDeadline :: DeadlineResponse -> Deadline +deadlineResponseToDeadline DeadlineResponse {..} = + Deadline + { _date = p_date + , _lang = p_lang + } + +-- | Convert DueResponse to Due +dueResponseToDue :: DueResponse -> Due +dueResponseToDue DueResponse {..} = + Due + { _date = p_date + , _string = p_string + , _lang = p_lang + , _is_recurring = p_is_recurring + , _timezone = p_timezone + } + +-- | Convert TaskResponse to Task +taskResponseToTask :: TaskResponse -> Task +taskResponseToTask TaskResponse {..} = + Task + { _id = TaskId p_id + , _content = Content p_content + , _description = Description p_description + , _project_id = ProjectId p_project_id + , _section_id = fmap (\sid -> SectionId {_id = sid}) p_section_id + , _parent_id = fmap ParentId p_parent_id + , _labels = p_labels + , _priority = p_priority + , _due = fmap dueResponseToDue p_due + , _deadline = fmap deadlineResponseToDeadline p_deadline + , _duration = fmap durationResponseToDuration p_duration + , _is_collapsed = IsCollapsed p_is_collapsed + , _order = Order p_child_order + , _assignee_id = fmap Uid p_responsible_uid + , _assigner_id = fmap Uid p_assigned_by_uid + , _completed_at = p_completed_at + , _creator_id = Uid p_user_id + , _created_at = fromMaybe "" p_added_at + , _updated_at = fromMaybe "" p_updated_at + } + +-- | Convert NewTaskResponse to NewTask +newTaskResponseToNewTask :: NewTaskResponse -> NewTask +newTaskResponseToNewTask NewTaskResponse {..} = + NewTask + { _user_id = p_user_id + , _id = TaskId p_id + , _project_id = ProjectId p_project_id + , _section_id = fmap (\sid -> SectionId {_id = sid}) p_section_id + , _parent_id = fmap ParentId p_parent_id + , _added_by_uid = fmap Uid p_added_by_uid + , _assigned_by_uid = fmap Uid p_assigned_by_uid + , _responsible_uid = fmap Uid p_responsible_uid + , _labels = p_labels + , _checked = p_checked + , _is_deleted = p_is_deleted + , _added_at = p_added_at + , _completed_at = p_completed_at + , _updated_at = p_updated_at + , _priority = p_priority + , _child_order = Order p_child_order + , _content = Content p_content + , _description = Description p_description + , _note_count = p_note_count + , _day_order = Order p_day_order + , _is_collapsed = IsCollapsed p_is_collapsed + } + +-- | Convert CommentResponse to Comment +-- Validates that at least one of task_id or project_id is present +commentResponseToComment :: CommentResponse -> Either TodoistError Comment +commentResponseToComment CommentResponse {..} = + case (p_item_id, p_project_id) of + (Nothing, Nothing) -> Left $ HttpError "Comment must have either task_id or project_id" + _ -> + Right $ + Comment + { _id = CommentId p_id + , _content = Content p_content + , _poster_id = fmap Uid p_posted_uid + , _posted_at = fmap Uid p_posted_at + , _task_id = fmap TaskId p_item_id + , _project_id = fmap ProjectId p_project_id + , _attachment = p_file_attachment + } + +-- | Convert SectionResponse to Section +sectionResponseToSection :: SectionResponse -> Section +sectionResponseToSection SectionResponse {..} = + Section + { _id = SectionId {_id = p_id} + , _name = Name p_name + , _project_id = ProjectId p_project_id + , _is_collapsed = IsCollapsed p_is_collapsed + , _order = Order p_section_order + } + +-- | Convert LabelResponse to Label +labelResponseToLabel :: LabelResponse -> Label +labelResponseToLabel LabelResponse {..} = + Label + { _id = LabelId p_id + , _name = Name p_name + , _color = Color p_color + , _order = fmap Order p_order + , _is_favorite = IsFavorite p_is_favorite + } + +-- ============================================================================ +-- TodoistProjectM Instance +-- ============================================================================ + +instance TodoistProjectM TodoistIO where + getProject :: ProjectId -> TodoistIO Project + getProject ProjectId {getProjectId = projectIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["projects", projectIdText] Nothing Nothing + resp <- liftIO $ apiGet (Proxy @ProjectResponse) config apiRequest + case resp of + Right res -> pure $ projectResponseToProject res + Left err -> lift $ except (Left err) + + getAllProjects :: TodoistIO [Project] + getAllProjects = TodoistIO $ do + config <- ask + let loop :: Maybe Text -> [Project] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [Project] + loop cursor acc = do + let params = PaginationParam {cursor = cursor, limit = Nothing} + apiRequest = mkTodoistRequest @Void ["projects"] (Just $ toQueryParam params) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn ProjectResponse)) config apiRequest + case resp of + Right res -> do + let newAcc = acc <> (projectResponseToProject <$> results res) + case next_cursor res of + Nothing -> pure newAcc + Just c -> loop (Just $ T.pack c) newAcc + Left err -> lift $ except (Left err) + loop Nothing [] + + getProjectCollaborators :: ProjectId -> TodoistIO [Collaborator] + getProjectCollaborators ProjectId {getProjectId = projectIdText} = TodoistIO $ do + config <- ask + let loop :: + Maybe Text -> [Collaborator] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [Collaborator] + loop cursor acc = do + let params = PaginationParam {cursor = cursor, limit = Nothing} + apiRequest = + mkTodoistRequest @Void + ["projects", projectIdText, "collaborators"] + (Just $ toQueryParam params) + Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn Collaborator)) config apiRequest + case resp of + Right res -> do + let newAcc = acc <> results res + case next_cursor res of + Nothing -> pure newAcc + Just c -> loop (Just $ T.pack c) newAcc + Left err -> lift $ except (Left err) + loop Nothing [] + + deleteProject :: ProjectId -> TodoistIO () + deleteProject ProjectId {getProjectId = projectIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["projects", projectIdText] Nothing Nothing + resp <- liftIO $ apiDelete config apiRequest + case resp of + Right _ -> pure () + Left err -> lift $ except (Left err) + + addProject :: ProjectCreate -> TodoistIO ProjectId + addProject project = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @ProjectCreate ["projects"] Nothing Nothing + resp <- liftIO $ apiPost (Just project) (JsonResponse (Proxy @ProjectId)) config apiRequest + case resp of + Right res -> pure res + Left err -> lift $ except (Left err) + + archiveProject :: ProjectId -> TodoistIO ProjectId + archiveProject ProjectId {getProjectId = projectIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["projects", projectIdText, "archive"] Nothing Nothing + resp <- liftIO $ apiPost (Nothing @Void) (JsonResponse (Proxy @ProjectId)) config apiRequest + case resp of + Right res -> pure res + Left err -> lift $ except (Left err) + + unarchiveProject :: ProjectId -> TodoistIO ProjectId + unarchiveProject ProjectId {getProjectId = projectIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["projects", projectIdText, "unarchive"] Nothing Nothing + resp <- liftIO $ apiPost (Nothing @Void) (JsonResponse (Proxy @ProjectId)) config apiRequest + case resp of + Right res -> pure res + Left err -> lift $ except (Left err) + + getProjectPermissions :: TodoistIO ProjectPermissions + getProjectPermissions = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["projects", "permissions"] Nothing Nothing + resp <- liftIO $ apiGet (Proxy @ProjectPermissions) config apiRequest + case resp of + Right res -> pure res + Left err -> lift $ except (Left err) + + updateProject :: ProjectUpdate -> ProjectId -> TodoistIO Project + updateProject projectUpdate ProjectId {getProjectId = projectIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @ProjectUpdate ["projects", projectIdText] Nothing Nothing + resp <- + liftIO $ apiPost (Just projectUpdate) (JsonResponse (Proxy @ProjectResponse)) config apiRequest + case resp of + Right res -> pure $ projectResponseToProject res + Left err -> lift $ except (Left err) + + getAllProjectsPaginated :: PaginationParam -> TodoistIO ([Project], Maybe Text) + getAllProjectsPaginated params = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["projects"] (Just $ toQueryParam params) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn ProjectResponse)) config apiRequest + case resp of + Right res -> + pure (projectResponseToProject <$> results res, fmap T.pack (next_cursor res)) + Left err -> lift $ except (Left err) + + getProjectCollaboratorsPaginated :: + PaginationParam -> ProjectId -> TodoistIO ([Collaborator], Maybe Text) + getProjectCollaboratorsPaginated params ProjectId {getProjectId = projectIdText} = TodoistIO $ do + config <- ask + let apiRequest = + mkTodoistRequest @Void + ["projects", projectIdText, "collaborators"] + (Just $ toQueryParam params) + Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn Collaborator)) config apiRequest + case resp of + Right res -> pure (results res, fmap T.pack (next_cursor res)) + Left err -> lift $ except (Left err) + + getAllProjectsWithLimit :: Int -> TodoistIO [Project] + getAllProjectsWithLimit pageLimit = TodoistIO $ do + let loop :: Maybe Text -> [Project] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [Project] + loop cursor acc = do + let params = PaginationParam {cursor = cursor, limit = Just pageLimit} + (projects, nextCursor) <- unTodoist $ getAllProjectsPaginated params + let newAcc = acc <> projects + case nextCursor of + Nothing -> pure newAcc + Just c -> loop (Just c) newAcc + loop Nothing [] + + getProjectCollaboratorsWithLimit :: Int -> ProjectId -> TodoistIO [Collaborator] + getProjectCollaboratorsWithLimit pageLimit projectId = TodoistIO $ do + let loop :: + Maybe Text -> [Collaborator] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [Collaborator] + loop cursor acc = do + let params = PaginationParam {cursor = cursor, limit = Just pageLimit} + (collaborators, nextCursor) <- unTodoist $ getProjectCollaboratorsPaginated params projectId + let newAcc = acc <> collaborators + case nextCursor of + Nothing -> pure newAcc + Just c -> loop (Just c) newAcc + loop Nothing [] + +-- ============================================================================ +-- TodoistTaskM Instance +-- ============================================================================ + +instance TodoistTaskM TodoistIO where + getTasks :: TaskParam -> TodoistIO [Task] + getTasks initialParams = TodoistIO $ do + config <- ask + let loop :: Maybe Text -> [Task] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [Task] + loop cursorVal acc = do + let TaskParam {project_id, section_id, parent_id, task_ids} = initialParams + params = TaskParam {project_id, section_id, parent_id, task_ids, cursor = cursorVal, limit = Nothing} + apiRequest = mkTodoistRequest @Void ["tasks"] (Just $ toQueryParam params) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn TaskResponse)) config apiRequest + case resp of + Right res -> do + let newAcc = acc <> fmap taskResponseToTask (results res) + case next_cursor res of + Nothing -> pure newAcc + Just c -> loop (Just $ T.pack c) newAcc + Left err -> lift $ except (Left err) + loop Nothing [] + + getTask :: TaskId -> TodoistIO Task + getTask TaskId {getTaskId = taskIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["tasks", taskIdText] Nothing Nothing + resp <- liftIO $ apiGet (Proxy @TaskResponse) config apiRequest + case resp of + Right res -> pure (taskResponseToTask res) + Left err -> lift $ except (Left err) + + createTask :: TaskCreate -> TodoistIO NewTask + createTask taskCreate = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @TaskCreate ["tasks"] Nothing Nothing + resp <- liftIO $ apiPost (Just taskCreate) (JsonResponse (Proxy @NewTaskResponse)) config apiRequest + case resp of + Right res -> pure (newTaskResponseToNewTask res) + Left err -> lift $ except (Left err) + + updateTask :: TaskUpdate -> TaskId -> TodoistIO NewTask + updateTask taskPatch TaskId {getTaskId = taskIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @TaskUpdate ["tasks", taskIdText] Nothing Nothing + resp <- liftIO $ apiPost (Just taskPatch) (JsonResponse (Proxy @NewTaskResponse)) config apiRequest + case resp of + Right res -> pure (newTaskResponseToNewTask res) + Left err -> lift $ except (Left err) + + closeTask :: TaskId -> TodoistIO () + closeTask TaskId {getTaskId = taskIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["tasks", taskIdText, "close"] Nothing Nothing + resp <- liftIO $ apiPost (Nothing @Void) IgnoreResponse config apiRequest + case resp of + Right _ -> pure () + Left err -> lift $ except (Left err) + + uncloseTask :: TaskId -> TodoistIO () + uncloseTask TaskId {getTaskId = taskIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["tasks", taskIdText, "reopen"] Nothing Nothing + resp <- liftIO $ apiPost (Nothing @Void) IgnoreResponse config apiRequest + case resp of + Right _ -> pure () + Left err -> lift $ except (Left err) + + deleteTask :: TaskId -> TodoistIO () + deleteTask TaskId {getTaskId = taskIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["tasks", taskIdText] Nothing Nothing + resp <- liftIO $ apiDelete config apiRequest + case resp of + Right _ -> pure () + Left err -> lift $ except (Left err) + + getTasksByFilter :: TaskFilter -> TodoistIO [TaskId] + getTasksByFilter initialFilter = TodoistIO $ do + config <- ask + let loop :: Maybe Text -> [TaskId] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [TaskId] + loop cursorVal acc = do + let TaskFilter {query, lang, limit} = initialFilter + filter' = TaskFilter {query, lang, cursor = cursorVal, limit} + apiRequest = mkTodoistRequest @Void ["tasks", "filter"] (Just $ toQueryParam filter') Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn TaskResponse)) config apiRequest + case resp of + Right res -> do + let taskIds = fmap (\TaskResponse {p_id} -> TaskId {getTaskId = p_id}) (results res) + let newAcc = acc <> taskIds + case next_cursor res of + Nothing -> pure newAcc + Just c -> loop (Just $ T.pack c) newAcc + Left err -> lift $ except (Left err) + loop Nothing [] + + moveTask :: MoveTask -> TaskId -> TodoistIO TaskId + moveTask moveTaskBody TaskId {getTaskId = taskIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @MoveTask ["tasks", taskIdText, "move"] Nothing Nothing + resp <- liftIO $ apiPost (Just moveTaskBody) (JsonResponse (Proxy @TaskResponse)) config apiRequest + case resp of + Right TaskResponse {p_id} -> pure $ TaskId {getTaskId = p_id} + Left err -> lift $ except (Left err) + + addTaskQuick :: AddTaskQuick -> TodoistIO () + addTaskQuick atqBody = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @AddTaskQuick ["tasks", "quick"] Nothing Nothing + resp <- liftIO $ apiPost (Just atqBody) IgnoreResponse config apiRequest + case resp of + Right _ -> pure () + Left err -> lift $ except (Left err) + + getCompletedTasksByDueDate :: CompletedTasksQueryParam -> TodoistIO [TaskId] + getCompletedTasksByDueDate completedTasksQueryParam = TodoistIO $ do + config <- ask + let apiRequest = + mkTodoistRequest @CompletedTasksQueryParam + ["tasks", "completed", "by_due_date"] + (Just $ toQueryParam completedTasksQueryParam) + Nothing + resp <- liftIO $ apiGet (Proxy @CompletedTasksQueryParamAPI) config apiRequest + case resp of + Right res -> pure $ fmap (\(TaskCompletedItem tid) -> TaskId {getTaskId = tid}) (items res) + Left err -> lift $ except (Left err) + + getCompletedTasksByCompletionDate :: CompletedTasksQueryParam -> TodoistIO [TaskId] + getCompletedTasksByCompletionDate completedTasksQueryParam = TodoistIO $ do + config <- ask + let apiRequest = + mkTodoistRequest @CompletedTasksQueryParam + ["tasks", "completed", "by_completion_date"] + (Just $ toQueryParam completedTasksQueryParam) + Nothing + resp <- liftIO $ apiGet (Proxy @CompletedTasksQueryParamAPI) config apiRequest + case resp of + Right res -> pure $ fmap (\(TaskCompletedItem tid) -> TaskId {getTaskId = tid}) (items res) + Left err -> lift $ except (Left err) + + getTasksPaginated :: TaskParam -> TodoistIO ([TaskId], Maybe Text) + getTasksPaginated taskparams = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["tasks"] (Just $ toQueryParam taskparams) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn TaskResponse)) config apiRequest + case resp of + Right res -> do + let taskIds = fmap (\TaskResponse {p_id} -> TaskId {getTaskId = p_id}) (results res) + pure (taskIds, fmap T.pack (next_cursor res)) + Left err -> lift $ except (Left err) + + getTasksByFilterPaginated :: TaskFilter -> TodoistIO ([TaskId], Maybe Text) + getTasksByFilterPaginated taskFilter = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["tasks", "filter"] (Just $ toQueryParam taskFilter) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn TaskResponse)) config apiRequest + case resp of + Right res -> do + let taskIds = fmap (\TaskResponse {p_id} -> TaskId {getTaskId = p_id}) (results res) + pure (taskIds, fmap T.pack (next_cursor res)) + Left err -> lift $ except (Left err) + + getTasksWithLimit :: Int -> TaskParam -> TodoistIO [TaskId] + getTasksWithLimit pageLimit baseParams = TodoistIO $ do + let loop :: Maybe Text -> [TaskId] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [TaskId] + loop cursorVal acc = do + let TaskParam {project_id, section_id, parent_id, task_ids} = baseParams + params = + TaskParam {project_id, section_id, parent_id, task_ids, cursor = cursorVal, limit = Just pageLimit} + (tasks, nextCursor) <- unTodoist $ getTasksPaginated params + let newAcc = acc <> tasks + case nextCursor of + Nothing -> pure newAcc + Just c -> loop (Just c) newAcc + loop Nothing [] + + getTasksByFilterWithLimit :: TaskFilter -> Int -> TodoistIO [TaskId] + getTasksByFilterWithLimit baseFilter pageLimit = TodoistIO $ do + let loop :: Maybe Text -> [TaskId] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [TaskId] + loop cursorVal acc = do + let TaskFilter {query, lang} = baseFilter + filter' = TaskFilter {query, lang, cursor = cursorVal, limit = Just pageLimit} + (tasks, nextCursor) <- unTodoist $ getTasksByFilterPaginated filter' + let newAcc = acc <> tasks + case nextCursor of + Nothing -> pure newAcc + Just c -> loop (Just c) newAcc + loop Nothing [] + +-- ============================================================================ +-- TodoistCommentM Instance +-- ============================================================================ + +instance TodoistCommentM TodoistIO where + addComment :: CommentCreate -> TodoistIO Comment + addComment comment = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @CommentCreate ["comments"] Nothing Nothing + resp <- liftIO $ apiPost (Just comment) (JsonResponse (Proxy @CommentResponse)) config apiRequest + case resp of + Right res -> do + let commentResults = commentResponseToComment res + case commentResults of + Left err -> lift $ except (Left err) + Right cmnt -> pure cmnt + Left err -> lift $ except (Left err) + + getComments :: CommentParam -> TodoistIO [Comment] + getComments initialParams = TodoistIO $ do + config <- ask + let loop :: Maybe Text -> [Comment] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [Comment] + loop cursorVal acc = do + let CommentParam {project_id, task_id, public_key} = initialParams + params = CommentParam {project_id, task_id, cursor = cursorVal, limit = Nothing, public_key} + apiRequest = mkTodoistRequest @Void ["comments"] (Just $ toQueryParam params) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn CommentResponse)) config apiRequest + case resp of + Right res -> do + let commentResults = traverse commentResponseToComment (results res) + case commentResults of + Left err -> lift $ except (Left err) + Right comments -> do + let newAcc = acc <> comments + case next_cursor res of + Nothing -> pure newAcc + Just c -> loop (Just $ T.pack c) newAcc + Left err -> lift $ except (Left err) + loop Nothing [] + + getCommentsPaginated :: CommentParam -> TodoistIO ([Comment], Maybe Text) + getCommentsPaginated params = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["comments"] (Just $ toQueryParam params) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn CommentResponse)) config apiRequest + case resp of + Right res -> do + let commentResults = traverse commentResponseToComment (results res) + nextCursor = fmap T.pack (next_cursor res) + case commentResults of + Left err -> lift $ except (Left err) + Right comments -> pure (comments, nextCursor) + Left err -> lift $ except (Left err) + + getComment :: CommentId -> TodoistIO Comment + getComment CommentId {getCommentId = commentIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["comments", commentIdText] Nothing Nothing + resp <- liftIO $ apiGet (Proxy @CommentResponse) config apiRequest + case resp of + Right res -> + case commentResponseToComment res of + Left err -> lift $ except (Left err) + Right comment -> pure comment + Left err -> lift $ except (Left err) + + updateComment :: CommentUpdate -> CommentId -> TodoistIO Comment + updateComment update CommentId {getCommentId = commentIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @CommentUpdate ["comments", commentIdText] Nothing Nothing + resp <- liftIO $ apiPost (Just update) (JsonResponse (Proxy @CommentResponse)) config apiRequest + case resp of + Right res -> + case commentResponseToComment res of + Left err -> lift $ except (Left err) + Right comment -> pure comment + Left err -> lift $ except (Left err) + + deleteComment :: CommentId -> TodoistIO () + deleteComment CommentId {getCommentId = commentIdText} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["comments", commentIdText] Nothing Nothing + resp <- liftIO $ apiDelete config apiRequest + case resp of + Right _ -> pure () + Left err -> lift $ except (Left err) + +-- ============================================================================ +-- TodoistSectionM Instance +-- ============================================================================ + +instance TodoistSectionM TodoistIO where + getSections :: SectionParam -> TodoistIO [Section] + getSections initialParams = TodoistIO $ do + config <- ask + let loop :: Maybe Text -> [Section] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [Section] + loop cursorVal acc = do + let SectionParam {project_id} = initialParams + params = SectionParam {project_id, cursor = cursorVal, limit = Nothing} + apiRequest = mkTodoistRequest @Void ["sections"] (Just $ toQueryParam params) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn SectionResponse)) config apiRequest + case resp of + Right res -> do + let newAcc = acc <> fmap sectionResponseToSection (results res) + case next_cursor res of + Nothing -> pure newAcc + Just c -> loop (Just $ T.pack c) newAcc + Left err -> lift $ except (Left err) + loop Nothing [] + + getSection :: SectionId -> TodoistIO Section + getSection SectionId {..} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["sections", _id] Nothing Nothing + resp <- liftIO $ apiGet (Proxy @SectionResponse) config apiRequest + case resp of + Right res -> pure $ sectionResponseToSection res + Left err -> lift $ except (Left err) + + addSection :: SectionCreate -> TodoistIO SectionId + addSection section = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @SectionCreate ["sections"] Nothing Nothing + resp <- liftIO $ apiPost (Just section) (JsonResponse (Proxy @SectionId)) config apiRequest + case resp of + Right res -> pure res + Left err -> lift $ except (Left err) + + updateSection :: SectionUpdate -> SectionId -> TodoistIO Section + updateSection sectionUpdate SectionId {..} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @SectionUpdate ["sections", _id] Nothing Nothing + resp <- + liftIO $ apiPost (Just sectionUpdate) (JsonResponse (Proxy @SectionResponse)) config apiRequest + case resp of + Right res -> pure $ sectionResponseToSection res + Left err -> lift $ except (Left err) + + deleteSection :: SectionId -> TodoistIO () + deleteSection SectionId {..} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["sections", _id] Nothing Nothing + resp <- liftIO $ apiDelete config apiRequest + case resp of + Right _ -> pure () + Left err -> lift $ except (Left err) + + getSectionsPaginated :: SectionParam -> TodoistIO ([Section], Maybe Text) + getSectionsPaginated sectionParams = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["sections"] (Just $ toQueryParam sectionParams) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn SectionResponse)) config apiRequest + case resp of + Right res -> pure (fmap sectionResponseToSection (results res), fmap T.pack (next_cursor res)) + Left err -> lift $ except (Left err) + +-- ============================================================================ +-- TodoistLabelM Instance +-- ============================================================================ + +instance TodoistLabelM TodoistIO where + getLabels :: LabelParam -> TodoistIO [Label] + getLabels _ = TodoistIO $ do + config <- ask + let loop :: Maybe Text -> [Label] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [Label] + loop cursorVal acc = do + let params = LabelParam {cursor = cursorVal, limit = Nothing} + apiRequest = mkTodoistRequest @Void ["labels"] (Just $ toQueryParam params) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn LabelResponse)) config apiRequest + case resp of + Right res -> do + let newAcc = acc <> fmap labelResponseToLabel (results res) + case next_cursor res of + Nothing -> pure newAcc + Just c -> loop (Just $ T.pack c) newAcc + Left err -> lift $ except (Left err) + loop Nothing [] + + getLabel :: LabelId -> TodoistIO Label + getLabel LabelId {..} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["labels", getLabelId] Nothing Nothing + resp <- liftIO $ apiGet (Proxy @LabelResponse) config apiRequest + case resp of + Right res -> pure $ labelResponseToLabel res + Left err -> lift $ except (Left err) + + addLabel :: LabelCreate -> TodoistIO LabelId + addLabel label = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @LabelCreate ["labels"] Nothing Nothing + resp <- liftIO $ apiPost (Just label) (JsonResponse (Proxy @LabelId)) config apiRequest + case resp of + Right res -> pure res + Left err -> lift $ except (Left err) + + updateLabel :: LabelUpdate -> LabelId -> TodoistIO Label + updateLabel labelUpdate LabelId {..} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @LabelUpdate ["labels", getLabelId] Nothing Nothing + resp <- + liftIO $ apiPost (Just labelUpdate) (JsonResponse (Proxy @LabelResponse)) config apiRequest + case resp of + Right res -> pure $ labelResponseToLabel res + Left err -> lift $ except (Left err) + + deleteLabel :: LabelId -> TodoistIO () + deleteLabel LabelId {..} = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["labels", getLabelId] Nothing Nothing + resp <- liftIO $ apiDelete config apiRequest + case resp of + Right _ -> pure () + Left err -> lift $ except (Left err) + + getLabelsPaginated :: LabelParam -> TodoistIO ([Label], Maybe Text) + getLabelsPaginated labelParams = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @Void ["labels"] (Just $ toQueryParam labelParams) Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn LabelResponse)) config apiRequest + case resp of + Right res -> pure (fmap labelResponseToLabel (results res), fmap T.pack (next_cursor res)) + Left err -> lift $ except (Left err) + + getSharedLabels :: SharedLabelParam -> TodoistIO [Text] + getSharedLabels (SharedLabelParam initialOmit _ _) = TodoistIO $ do + config <- ask + let loop :: Maybe Text -> [Text] -> ReaderT TodoistConfig (ExceptT TodoistError IO) [Text] + loop cursorVal acc = do + let params = SharedLabelParam {omit_personal = initialOmit, cursor = cursorVal, limit = Nothing} + apiRequest = + mkTodoistRequest @Void + ["labels", "shared"] + (Just $ toQueryParam (params :: SharedLabelParam)) + Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn Text)) config apiRequest + case resp of + Right res -> do + let newAcc = acc <> results res + case next_cursor res of + Nothing -> pure newAcc + Just c -> loop (Just $ T.pack c) newAcc + Left err -> lift $ except (Left err) + loop Nothing [] + + getSharedLabelsPaginated :: SharedLabelParam -> TodoistIO ([Text], Maybe Text) + getSharedLabelsPaginated sharedParams = TodoistIO $ do + config <- ask + let apiRequest = + mkTodoistRequest @Void + ["labels", "shared"] + (Just $ toQueryParam (sharedParams :: SharedLabelParam)) + Nothing + resp <- liftIO $ apiGet (Proxy @(TodoistReturn Text)) config apiRequest + case resp of + Right res -> pure (results res, fmap T.pack (next_cursor res)) + Left err -> lift $ except (Left err) + + removeSharedLabels :: SharedLabelRemove -> TodoistIO () + removeSharedLabels removeReq = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @SharedLabelRemove ["labels", "shared", "remove"] Nothing Nothing + resp <- liftIO $ apiPost (Just removeReq) IgnoreResponse config apiRequest + case resp of + Right _ -> pure () + Left err -> lift $ except (Left err) + + renameSharedLabels :: SharedLabelRename -> TodoistIO () + renameSharedLabels renameReq = TodoistIO $ do + config <- ask + let apiRequest = mkTodoistRequest @SharedLabelRename ["labels", "shared", "rename"] Nothing Nothing + resp <- liftIO $ apiPost (Just renameReq) IgnoreResponse config apiRequest + case resp of + Right _ -> pure () + Left err -> lift $ except (Left err) diff --git a/src/Web/Todoist/Runner/Trace.hs b/src/Web/Todoist/Runner/Trace.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Runner/Trace.hs @@ -0,0 +1,400 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Web.Todoist.Runner.Trace + ( Op (..) + , Trace (..) + ) where + +import Web.Todoist.Domain.Comment + ( Comment (..) + , CommentCreate + , CommentId (..) + , CommentParam + , CommentUpdate + , Content (..) + , TodoistCommentM (..) + ) +import Web.Todoist.Domain.Label + ( Label (..) + , LabelCreate + , LabelId (LabelId) + , LabelParam + , LabelUpdate + , SharedLabelParam + , SharedLabelRemove + , SharedLabelRename + , TodoistLabelM (..) + ) +import Web.Todoist.Domain.Project + ( CanAssignTasks (..) + , Collaborator (Collaborator) + , IsArchived (..) + , IsShared (..) + , PaginationParam + , Project (Project) + , ProjectCreate + , ProjectUpdate + , TodoistProjectM (..) + ) +import Web.Todoist.Internal.Types (ProjectPermissions (ProjectPermissions)) +import Web.Todoist.Domain.Section + ( Section (..) + , SectionCreate + , SectionId (SectionId) + , SectionParam + , SectionUpdate + , TodoistSectionM (..) + ) +import Web.Todoist.Domain.Task + ( AddTaskQuick + , CompletedTasksQueryParam + , MoveTask + , NewTask (..) + , Task (..) + , TaskCreate + , TaskFilter + , TaskParam + , TaskUpdate + , TodoistTaskM (..) + ) +import Web.Todoist.Domain.Types + ( Color (..) + , Description (..) + , IsCollapsed (..) + , IsFavorite (..) + , Name (..) + , Order (..) + , ProjectId (..) + , TaskId (..) + , Uid (..) + , ViewStyle (..) + ) + +import Control.Applicative (Applicative, pure) +import Control.Monad (Functor, Monad) +import Control.Monad.Trans.Writer (Writer, tell) +import Data.Bool (Bool (False)) +import Data.Function (($)) +import Data.Int (Int) +import Data.Maybe (Maybe (Nothing)) +import Data.Text (Text) +import Text.Show (Show) + +data Op + = ProjectOp ProjectOp + | TaskOp TaskOp + | CommentOp CommentOp + | SectionOp SectionOp + | LabelOp LabelOp + deriving (Show) + +data ProjectOp + = GetAllProjects + | GetProjectCollaborators + | AddProject + deriving (Show) + +data TaskOp + = GetTasks + | GetTask + | AddTask + | UpdateTask + | CloseTask + | DeleteTask + | UncloseTask + deriving (Show) + +data CommentOp + = AddComment + | GetComments + | GetCommentsPaginated + | GetComment + | UpdateComment + | DeleteComment + deriving (Show) + +data SectionOp + = GetSections + | GetSection + | AddSection + | UpdateSection + | DeleteSection + | GetSectionsPaginated + deriving (Show) + +data LabelOp + = GetLabels + | GetLabel + | AddLabel + | UpdateLabel + | DeleteLabel + | GetLabelsPaginated + | GetSharedLabels + | GetSharedLabelsPaginated + | RemoveSharedLabels + | RenameSharedLabels + deriving (Show) + +newtype Trace a = Trace {runTrace :: Writer [Op] a} + deriving (Functor, Applicative, Monad) + +instance TodoistProjectM Trace where + getAllProjects :: Trace [Project] + getAllProjects = Trace $ do + tell [ProjectOp GetAllProjects] + pure [] + + getProject :: ProjectId -> Trace Project + getProject _ = Trace $ do + tell [ProjectOp GetAllProjects] + pure $ Project (ProjectId "") (Name "") (Description "") (Order 0) (Color "") (IsCollapsed False) (IsShared False) (IsFavorite False) (IsArchived False) (CanAssignTasks False) List Nothing Nothing + + getProjectCollaborators :: ProjectId -> Trace [Collaborator] + getProjectCollaborators _ = Trace $ do + tell [ProjectOp GetProjectCollaborators] + pure [Collaborator "" (Name "") ""] + + addProject :: ProjectCreate -> Trace ProjectId + addProject _ = Trace $ do + tell [ProjectOp AddProject] + pure $ ProjectId "" + + deleteProject :: ProjectId -> Trace () + deleteProject _ = Trace $ do + tell [ProjectOp AddProject] + pure () + + archiveProject :: ProjectId -> Trace ProjectId + archiveProject pid = Trace $ do + tell [ProjectOp AddProject] + pure pid + + unarchiveProject :: ProjectId -> Trace ProjectId + unarchiveProject pid = Trace $ do + tell [ProjectOp AddProject] + pure pid + + getProjectPermissions :: Trace ProjectPermissions + getProjectPermissions = Trace $ do + tell [ProjectOp GetAllProjects] + pure $ ProjectPermissions [] [] + + updateProject :: ProjectUpdate -> ProjectId -> Trace Project + updateProject _ _ = Trace $ do + tell [ProjectOp AddProject] + pure $ Project (ProjectId "") (Name "") (Description "") (Order 0) (Color "") (IsCollapsed False) (IsShared False) (IsFavorite False) (IsArchived False) (CanAssignTasks False) List Nothing Nothing + + getAllProjectsPaginated :: PaginationParam -> Trace ([Project], Maybe Text) + getAllProjectsPaginated _ = Trace $ do + tell [ProjectOp GetAllProjects] + pure ([], Nothing) + + getProjectCollaboratorsPaginated :: PaginationParam -> ProjectId -> Trace ([Collaborator], Maybe Text) + getProjectCollaboratorsPaginated _ _ = Trace $ do + tell [ProjectOp GetProjectCollaborators] + pure ([], Nothing) + + getAllProjectsWithLimit :: Int -> Trace [Project] + getAllProjectsWithLimit _ = Trace $ do + tell [ProjectOp GetAllProjects] + pure [] + + getProjectCollaboratorsWithLimit :: Int -> ProjectId -> Trace [Collaborator] + getProjectCollaboratorsWithLimit _ _ = Trace $ do + tell [ProjectOp GetProjectCollaborators] + pure [] + +instance TodoistTaskM Trace where + getTasks :: TaskParam -> Trace [Task] + getTasks _ = Trace $ do + tell [TaskOp GetTasks] + pure [] + + getTask :: TaskId -> Trace Task + getTask tid = Trace $ do + tell [TaskOp GetTask] + pure $ Task tid (Content "") (Description "") (ProjectId "") Nothing Nothing [] 0 Nothing Nothing Nothing (IsCollapsed False) (Order 0) Nothing Nothing Nothing (Uid "") "" "" + + createTask :: TaskCreate -> Trace NewTask + createTask _ = Trace $ do + tell [TaskOp AddTask] + pure $ NewTask "" (TaskId "") (ProjectId "") Nothing Nothing Nothing Nothing Nothing [] False False Nothing Nothing Nothing 0 (Order 0) (Content "") (Description "") 0 (Order 0) (IsCollapsed False) + + updateTask :: TaskUpdate -> TaskId -> Trace NewTask + updateTask _ _ = Trace $ do + tell [TaskOp UpdateTask] + pure $ NewTask "" (TaskId "") (ProjectId "") Nothing Nothing Nothing Nothing Nothing [] False False Nothing Nothing Nothing 0 (Order 0) (Content "") (Description "") 0 (Order 0) (IsCollapsed False) + + closeTask :: TaskId -> Trace () + closeTask _ = Trace $ do + tell [TaskOp CloseTask] + pure () + + uncloseTask :: TaskId -> Trace () + uncloseTask _ = Trace $ do + tell [TaskOp UncloseTask] + pure () + + deleteTask :: TaskId -> Trace () + deleteTask _ = Trace $ do + tell [TaskOp DeleteTask] + pure () + + getTasksByFilter :: TaskFilter -> Trace [TaskId] + getTasksByFilter _ = Trace $ do + tell [TaskOp GetTasks] + pure [] + + moveTask :: MoveTask -> TaskId -> Trace TaskId + moveTask _ tid = Trace $ do + tell [TaskOp UpdateTask] + pure tid + + addTaskQuick :: AddTaskQuick -> Trace () + addTaskQuick _ = Trace $ do + tell [TaskOp AddTask] + pure () + + getCompletedTasksByDueDate :: CompletedTasksQueryParam -> Trace [TaskId] + getCompletedTasksByDueDate _ = Trace $ do + tell [TaskOp GetTasks] + pure [] + + getCompletedTasksByCompletionDate :: CompletedTasksQueryParam -> Trace [TaskId] + getCompletedTasksByCompletionDate _ = Trace $ do + tell [TaskOp GetTasks] + pure [] + + getTasksPaginated :: TaskParam -> Trace ([TaskId], Maybe Text) + getTasksPaginated _ = Trace $ do + tell [TaskOp GetTasks] + pure ([], Nothing) + + getTasksByFilterPaginated :: TaskFilter -> Trace ([TaskId], Maybe Text) + getTasksByFilterPaginated _ = Trace $ do + tell [TaskOp GetTasks] + pure ([], Nothing) + + getTasksWithLimit :: Int -> TaskParam -> Trace [TaskId] + getTasksWithLimit _ _ = Trace $ do + tell [TaskOp GetTasks] + pure [] + + getTasksByFilterWithLimit :: TaskFilter -> Int -> Trace [TaskId] + getTasksByFilterWithLimit _ _ = Trace $ do + tell [TaskOp GetTasks] + pure [] + +instance TodoistCommentM Trace where + addComment :: CommentCreate -> Trace Comment + addComment _ = Trace $ do + tell [CommentOp AddComment] + pure $ Comment (CommentId "") (Content "") Nothing Nothing Nothing Nothing Nothing + + getComments :: CommentParam -> Trace [Comment] + getComments _ = Trace $ do + tell [CommentOp GetComments] + pure [] + + getCommentsPaginated :: CommentParam -> Trace ([Comment], Maybe Text) + getCommentsPaginated _ = Trace $ do + tell [CommentOp GetCommentsPaginated] + pure ([], Nothing) + + getComment :: CommentId -> Trace Comment + getComment _ = Trace $ do + tell [CommentOp GetComment] + pure $ Comment (CommentId "") (Content "") Nothing Nothing Nothing Nothing Nothing + + updateComment :: CommentUpdate -> CommentId -> Trace Comment + updateComment _ _ = Trace $ do + tell [CommentOp UpdateComment] + pure $ Comment (CommentId "") (Content "") Nothing Nothing Nothing Nothing Nothing + + deleteComment :: CommentId -> Trace () + deleteComment _ = Trace $ do + tell [CommentOp DeleteComment] + pure () + +instance TodoistSectionM Trace where + getSections :: SectionParam -> Trace [Section] + getSections _ = Trace $ do + tell [SectionOp GetSections] + pure [] + + getSection :: SectionId -> Trace Section + getSection _ = Trace $ do + tell [SectionOp GetSection] + pure $ Section (SectionId "") (Name "") (ProjectId "") (IsCollapsed False) (Order 0) + + addSection :: SectionCreate -> Trace SectionId + addSection _ = Trace $ do + tell [SectionOp AddSection] + pure $ SectionId "" + + updateSection :: SectionUpdate -> SectionId -> Trace Section + updateSection _ _ = Trace $ do + tell [SectionOp UpdateSection] + pure $ Section (SectionId "") (Name "") (ProjectId "") (IsCollapsed False) (Order 0) + + deleteSection :: SectionId -> Trace () + deleteSection _ = Trace $ do + tell [SectionOp DeleteSection] + pure () + + getSectionsPaginated :: SectionParam -> Trace ([Section], Maybe Text) + getSectionsPaginated _ = Trace $ do + tell [SectionOp GetSectionsPaginated] + pure ([], Nothing) + +instance TodoistLabelM Trace where + getLabels :: LabelParam -> Trace [Label] + getLabels _ = Trace $ do + tell [LabelOp GetLabels] + pure [] + + getLabel :: LabelId -> Trace Label + getLabel _ = Trace $ do + tell [LabelOp GetLabel] + pure $ Label (LabelId "") (Name "") (Color "") Nothing (IsFavorite False) + + addLabel :: LabelCreate -> Trace LabelId + addLabel _ = Trace $ do + tell [LabelOp AddLabel] + pure $ LabelId "" + + updateLabel :: LabelUpdate -> LabelId -> Trace Label + updateLabel _ _ = Trace $ do + tell [LabelOp UpdateLabel] + pure $ Label (LabelId "") (Name "") (Color "") Nothing (IsFavorite False) + + deleteLabel :: LabelId -> Trace () + deleteLabel _ = Trace $ do + tell [LabelOp DeleteLabel] + pure () + + getLabelsPaginated :: LabelParam -> Trace ([Label], Maybe Text) + getLabelsPaginated _ = Trace $ do + tell [LabelOp GetLabelsPaginated] + pure ([], Nothing) + + getSharedLabels :: SharedLabelParam -> Trace [Text] + getSharedLabels _ = Trace $ do + tell [LabelOp GetSharedLabels] + pure [] + + getSharedLabelsPaginated :: SharedLabelParam -> Trace ([Text], Maybe Text) + getSharedLabelsPaginated _ = Trace $ do + tell [LabelOp GetSharedLabelsPaginated] + pure ([], Nothing) + + removeSharedLabels :: SharedLabelRemove -> Trace () + removeSharedLabels _ = Trace $ do + tell [LabelOp RemoveSharedLabels] + pure () + + renameSharedLabels :: SharedLabelRename -> Trace () + renameSharedLabels _ = Trace $ do + tell [LabelOp RenameSharedLabels] + pure () diff --git a/src/Web/Todoist/Util/Builder.hs b/src/Web/Todoist/Util/Builder.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Util/Builder.hs @@ -0,0 +1,388 @@ +{-# LANGUAGE RankNTypes #-} + +{- | Builder pattern for constructing domain types with optional fields. + +This module provides a type-safe builder pattern for creating domain request types +(like ProjectCreate, TaskCreate, etc.) with ergonomic field setting. + +Example usage: + +@ +let project = runBuilder (createProjectBuilder \"My Project\") + (withDescription \"A description\" <> withViewStyle Board) +@ +-} +module Web.Todoist.Util.Builder + ( -- * Builder Core Types + Builder + , Initial + , runBuilder + , seed + + -- * Setter Functions + , withDescription + , withParentId + , withProjectId + , withTaskId + , withViewStyle + , withWorkspaceId + , withName + , withIsFavorite + , withContent + , withColor + , withSectionId + , withOrder + , withLabels + , withPriority + , withAssigneeId + , withDueString + , withDueDate + , withDueDatetime + , withDueLang + , withDuration + , withDurationUnit + , withDeadlineDate + , withAttachment + , withUidsToNotify + , withCursor + , withLimit + , withQuery + , withLang + , withSince + , withUntil + , withTaskIds + , withPublicKey + , withOmitPersonal + , withFilterQuery + , withFilterLang + + -- * Type Classes (for implementing Has* instances) + , HasDescription (..) + , HasParentId (..) + , HasProjectId (..) + , HasViewStyle (..) + , HasWorkspaceId (..) + , HasName (..) + , HasIsFavorite (..) + , HasContent (..) + , HasSectionId (..) + , HasOrder (..) + , HasLabels (..) + , HasPriority (..) + , HasAssigneeId (..) + , HasDueString (..) + , HasDueDate (..) + , HasDueDatetime (..) + , HasDueLang (..) + , HasDuration (..) + , HasDurationUnit (..) + , HasDeadlineDate (..) + , HasTaskId (..) + , HasUidsToNotify (..) + , HasAttachment (..) + , HasColor (..) + , HasCursor (..) + , HasLimit (..) + , HasQuery (..) + , HasLang (..) + , HasSince (..) + , HasUntil (..) + , HasTaskIds (..) + , HasPublicKey (..) + , HasOmitPersonal (..) + , HasFilterQuery (..) + , HasFilterLang (..) + ) where + +import Web.Todoist.Domain.Types (Attachment, ViewStyle) + +import Data.Bool (Bool) +import Data.Int (Int) +import Data.Monoid (Dual (..), Endo (..), Monoid (..)) +import Data.Semigroup (Semigroup (..)) +import Data.Text (Text) + +-- ============================================================================ +-- Type Classes +-- ============================================================================ + +class HasDescription p where + hasDescription :: Text -> p -> p + +class HasParentId p where + hasParentId :: Text -> p -> p + +class HasProjectId p where + hasProjectId :: Text -> p -> p + +class HasViewStyle p where + hasViewStyle :: ViewStyle -> p -> p + +class HasWorkspaceId p where + hasWorkspaceId :: Int -> p -> p + +-- | Type class for types that have a name field +class HasName p where + hasName :: Text -> p -> p + +-- | Type class for types that have an is_favorite field +class HasIsFavorite p where + hasIsFavorite :: Bool -> p -> p + +class HasContent p where + hasContent :: Text -> p -> p + +class HasSectionId p where + hasSectionId :: Text -> p -> p + +class HasOrder p where + hasOrder :: Int -> p -> p + +class HasLabels p where + hasLabels :: [Text] -> p -> p + +class HasPriority p where + hasPriority :: Int -> p -> p + +class HasAssigneeId p where + hasAssigneeId :: Int -> p -> p + +class HasDueString p where + hasDueString :: Text -> p -> p + +class HasDueDate p where + hasDueDate :: Text -> p -> p + +class HasDueDatetime p where + hasDueDatetime :: Text -> p -> p + +class HasDueLang p where + hasDueLang :: Text -> p -> p + +class HasDuration p where + hasDuration :: Int -> p -> p + +class HasDurationUnit p where + hasDurationUnit :: Text -> p -> p + +class HasDeadlineDate p where + hasDeadlineDate :: Text -> p -> p + +-- Comment-specific setters +class HasTaskId p where + hasTaskId :: Text -> p -> p + +class HasUidsToNotify p where + hasUidsToNotify :: [Int] -> p -> p + +class HasAttachment p where + hasAttachment :: Attachment -> p -> p + +class HasColor p where + hasColor :: Text -> p -> p + +-- QueryParam-specific type classes +class HasCursor p where + hasCursor :: Text -> p -> p + +class HasLimit p where + hasLimit :: Int -> p -> p + +class HasQuery p where + hasQuery :: Text -> p -> p + +class HasLang p where + hasLang :: Text -> p -> p + +class HasSince p where + hasSince :: Text -> p -> p + +class HasUntil p where + hasUntil :: Text -> p -> p + +class HasTaskIds p where + hasTaskIds :: [Text] -> p -> p + +class HasPublicKey p where + hasPublicKey :: Text -> p -> p + +class HasOmitPersonal p where + hasOmitPersonal :: Bool -> p -> p + +class HasFilterQuery p where + hasFilterQuery :: Text -> p -> p + +class HasFilterLang p where + hasFilterLang :: Text -> p -> p + +-- ============================================================================ +-- Builder Types and Functions +-- ============================================================================ + +-- Newtype for seed values (constructor NOT exported) +newtype Initial s = Initial s + +newtype Builder s = Builder + { bMods :: Dual (Endo s) -- Dual for left-to-right application order + } + +instance Semigroup (Builder s) where + (<>) :: Builder s -> Builder s -> Builder s + Builder md1 <> Builder md2 = Builder (md1 <> md2) + +instance Monoid (Builder s) where + mempty :: Builder s + mempty = Builder mempty + +runBuilder :: Initial s -> Builder s -> s +runBuilder (Initial s) (Builder (Dual (Endo f))) = f s + +seed :: s -> Initial s +seed = Initial + +modB :: (s -> s) -> Builder s +modB f = Builder {bMods = Dual {getDual = Endo {appEndo = f}}} + +-- ============================================================================ +-- Setter Functions +-- ============================================================================ + +-- | Set the description field for projects or tasks +withDescription :: (HasDescription s) => Text -> Builder s +withDescription desc = modB (hasDescription desc) + +-- | Set the parent project or task ID for hierarchical organization +withParentId :: (HasParentId s) => Text -> Builder s +withParentId pid = modB (hasParentId pid) + +-- | Set the project ID to assign a task to a specific project +withProjectId :: (HasProjectId s) => Text -> Builder s +withProjectId pid = modB (hasProjectId pid) + +-- | Set the view style for a project (List, Board, or Calendar) +withViewStyle :: (HasViewStyle s) => ViewStyle -> Builder s +withViewStyle style = modB (hasViewStyle style) + +-- | Set the workspace ID for team/workspace assignment +withWorkspaceId :: (HasWorkspaceId s) => Int -> Builder s +withWorkspaceId wid = modB (hasWorkspaceId wid) + +-- | Set the name field for projects, sections, or labels +withName :: (HasName s) => Text -> Builder s +withName name = modB (hasName name) + +-- | Set whether an item is marked as favorite +withIsFavorite :: (HasIsFavorite s) => Bool -> Builder s +withIsFavorite fav = modB (hasIsFavorite fav) + +-- | Set the content (title/description) field for tasks +withContent :: (HasContent s) => Text -> Builder s +withContent content = modB (hasContent content) + +-- | Set the color field for labels +withColor :: (HasColor s) => Text -> Builder s +withColor color = modB (hasColor color) + +-- | Set the section ID to organize a task within a project section +withSectionId :: (HasSectionId s) => Text -> Builder s +withSectionId sid = modB (hasSectionId sid) + +-- | Set the sort order (lower numbers appear first) +withOrder :: (HasOrder s) => Int -> Builder s +withOrder order = modB (hasOrder order) + +-- | Set the list of label names to tag a task +withLabels :: (HasLabels s) => [Text] -> Builder s +withLabels labels = modB (hasLabels labels) + +-- | Set the priority level (1=urgent, 2=high, 3=normal, 4=low) +withPriority :: (HasPriority s) => Int -> Builder s +withPriority priority = modB (hasPriority priority) + +-- | Set the assignee user ID for task assignment +withAssigneeId :: (HasAssigneeId s) => Int -> Builder s +withAssigneeId aid = modB (hasAssigneeId aid) + +-- | Set a natural language due date string (e.g., \"tomorrow\", \"next Monday\") +withDueString :: (HasDueString s) => Text -> Builder s +withDueString dueStr = modB (hasDueString dueStr) + +-- | Set the due date in YYYY-MM-DD format +withDueDate :: (HasDueDate s) => Text -> Builder s +withDueDate dueDate = modB (hasDueDate dueDate) + +-- | Set the due datetime in RFC3339 format with timezone +withDueDatetime :: (HasDueDatetime s) => Text -> Builder s +withDueDatetime dueDatetime = modB (hasDueDatetime dueDatetime) + +-- | Set the language code for parsing natural language due strings +withDueLang :: (HasDueLang s) => Text -> Builder s +withDueLang dueLang = modB (hasDueLang dueLang) + +-- | Set the task duration amount (used with duration_unit) +withDuration :: (HasDuration s) => Int -> Builder s +withDuration duration = modB (hasDuration duration) + +-- | Set the task duration unit (\"minute\" or \"day\") +withDurationUnit :: (HasDurationUnit s) => Text -> Builder s +withDurationUnit durationUnit = modB (hasDurationUnit durationUnit) + +-- | Set the deadline date for a task +withDeadlineDate :: (HasDeadlineDate s) => Text -> Builder s +withDeadlineDate deadlineDate = modB (hasDeadlineDate deadlineDate) + +-- | Set an attachment for a comment +withAttachment :: (HasAttachment s) => Attachment -> Builder s +withAttachment attachment = modB (hasAttachment attachment) + +-- | Set the task ID for comments to associate a comment with a task +withTaskId :: (HasTaskId s) => Text -> Builder s +withTaskId tid = modB (hasTaskId tid) + +-- | Set the list of user IDs to notify about a comment +withUidsToNotify :: (HasUidsToNotify s) => [Int] -> Builder s +withUidsToNotify uids = modB (hasUidsToNotify uids) + +-- | Set the pagination cursor for fetching the next page of results +withCursor :: (HasCursor s) => Text -> Builder s +withCursor cursor = modB (hasCursor cursor) + +-- | Set the maximum number of items to return per page +withLimit :: (HasLimit s) => Int -> Builder s +withLimit limit = modB (hasLimit limit) + +-- | Set the search query text for filtering items +withQuery :: (HasQuery s) => Text -> Builder s +withQuery query = modB (hasQuery query) + +-- | Set the language code for natural language processing +withLang :: (HasLang s) => Text -> Builder s +withLang lang = modB (hasLang lang) + +-- | Set the start date for date range filtering +withSince :: (HasSince s) => Text -> Builder s +withSince since = modB (hasSince since) + +-- | Set the end date for date range filtering +withUntil :: (HasUntil s) => Text -> Builder s +withUntil until = modB (hasUntil until) + +-- | Set the list of task IDs for filtering by specific tasks +withTaskIds :: (HasTaskIds s) => [Text] -> Builder s +withTaskIds taskIds = modB (hasTaskIds taskIds) + +-- | Set the public key for accessing shared comments +withPublicKey :: (HasPublicKey s) => Text -> Builder s +withPublicKey publicKey = modB (hasPublicKey publicKey) + +-- | Set whether to omit personal labels from results +withOmitPersonal :: (HasOmitPersonal s) => Bool -> Builder s +withOmitPersonal omitPersonal = modB (hasOmitPersonal omitPersonal) + +-- | Set the filter query for completed tasks +withFilterQuery :: (HasFilterQuery s) => Text -> Builder s +withFilterQuery filterQuery = modB (hasFilterQuery filterQuery) + +-- | Set the filter language for completed tasks +withFilterLang :: (HasFilterLang s) => Text -> Builder s +withFilterLang filterLang = modB (hasFilterLang filterLang) diff --git a/src/Web/Todoist/Util/QueryParam.hs b/src/Web/Todoist/Util/QueryParam.hs new file mode 100644 --- /dev/null +++ b/src/Web/Todoist/Util/QueryParam.hs @@ -0,0 +1,11 @@ +module Web.Todoist.Util.QueryParam + ( QueryParam (..) + ) where + +import Web.Todoist.Internal.Types (Params) + +{- | Type class for converting domain types to HTTP query parameters. +Used by various parameter types across different domains (Task, Project, etc.) +-} +class QueryParam a where + toQueryParam :: a -> Params diff --git a/src/internal/Web/Todoist/Internal/Config.hs b/src/internal/Web/Todoist/Internal/Config.hs new file mode 100644 --- /dev/null +++ b/src/internal/Web/Todoist/Internal/Config.hs @@ -0,0 +1,48 @@ +{- | +Module : Web.Todoist.Internal.Config +Description : Configuration types for Todoist API client +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +Internal module providing configuration types for the Todoist API client. +These types hold authentication credentials and are used by the HTTP layer +to make authenticated requests. + +This is an internal module and not meant for direct use by end users. +Use 'newTodoistConfig' from "Web.Todoist.Runner" instead. +-} +module Web.Todoist.Internal.Config + ( TodoistConfig (..) + , Token (..) + , getAuthToken + ) where + +import qualified Data.ByteString.Char8 as B +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Text.Show (Show) + +{- | API authentication token wrapper + +Wraps the raw API token text. Tokens can be obtained from +Todoist Settings → Integrations → Developer. +-} +newtype Token = Token Text deriving (Show) + +{- | Configuration for Todoist API client + +Contains the authentication token needed to make API requests. +Constructed using 'newTodoistConfig' from "Web.Todoist.Runner". +-} +newtype TodoistConfig = TodoistConfig + { authToken :: Token + } + deriving (Show) + +{- | Extract the raw ByteString from a Token + +Converts the token to UTF-8 encoded ByteString for use in HTTP headers. +-} +getAuthToken :: Token -> B.ByteString +getAuthToken (Token tkn) = encodeUtf8 tkn diff --git a/src/internal/Web/Todoist/Internal/Error.hs b/src/internal/Web/Todoist/Internal/Error.hs new file mode 100644 --- /dev/null +++ b/src/internal/Web/Todoist/Internal/Error.hs @@ -0,0 +1,42 @@ +{- | +Module : Web.Todoist.Internal.Error +Description : Error types for Todoist API operations +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +Internal module defining error types that can occur during Todoist API operations. +These errors are returned in the Left side of 'Either TodoistError a' results. + +This is an internal module. End users will see these errors but don't need to +import this module directly - they're re-exported from the main API. +-} +module Web.Todoist.Internal.Error + ( TodoistError (..) + ) where + +import Data.String (String) +import Text.Show (Show) + +{- | Errors that can occur when interacting with the Todoist API + +Covers common HTTP error codes and general HTTP exceptions: + +- 'BadRequest': HTTP 400 - Invalid request parameters +- 'NotFound': HTTP 404 - Resource not found +- 'Forbidden': HTTP 403 - Access denied to resource +- 'Unauthorized': HTTP 401 - Invalid or missing authentication token +- 'HttpError': Other HTTP errors (network issues, unexpected status codes) +-} +data TodoistError + = -- | HTTP 400 - Invalid request parameters or malformed request + BadRequest + | -- | HTTP 404 - Requested resource (project, task, etc.) not found + NotFound + | -- | HTTP 403 - Access denied (insufficient permissions) + Forbidden + | -- | HTTP 401 - Invalid or missing API authentication token + Unauthorized + | -- | Other HTTP errors (network issues, unexpected status codes, etc.) + HttpError String + deriving (Show) diff --git a/src/internal/Web/Todoist/Internal/HTTP.hs b/src/internal/Web/Todoist/Internal/HTTP.hs new file mode 100644 --- /dev/null +++ b/src/internal/Web/Todoist/Internal/HTTP.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{- | +Module : Web.Todoist.Internal.HTTP +Description : HTTP client functions for Todoist REST API +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +Internal module providing low-level HTTP operations for the Todoist REST API. +Uses the @req@ library to make authenticated HTTP requests (GET, POST, DELETE) +and handles error responses. + +All functions return @Either TodoistError a@ to represent possible failures. +HTTP exceptions are caught and converted to 'TodoistError' values. +-} +module Web.Todoist.Internal.HTTP + ( apiGet + , apiPost + , PostResponse (..) + , apiDelete + , getAuthHeader + ) where + +import Web.Todoist.Internal.Config (TodoistConfig (..), getAuthToken) +import Web.Todoist.Internal.Error (TodoistError (..)) +import Web.Todoist.Internal.Request (TodoistRequest (..), getScheme) + +import Control.Exception (try) +import Data.Either (Either (..)) +import Data.Function (($), (.)) +import qualified Data.List as L +import Data.Maybe (Maybe (..)) +import Data.Monoid (mconcat, (<>)) +import Data.Proxy (Proxy (..)) +import System.IO (IO) +import Text.Show (show) + +import Control.Applicative (Applicative (pure)) +import Data.Aeson (FromJSON, ToJSON) +import Network.HTTP.Req ((=:)) +import qualified Network.HTTP.Req as Http + +{- | GADT for specifying how to handle POST response +This ties the response handling strategy to the return type +-} +data PostResponse a where + -- | Ignore the response body, return () + IgnoreResponse :: PostResponse () + -- | Parse JSON response into type 'a' (requires FromJSON constraint) + JsonResponse :: (FromJSON a) => Proxy a -> PostResponse a + +{- | Perform a GET request to the Todoist API + +Makes an authenticated GET request to retrieve data from the API. +Query parameters from the 'TodoistRequest' are added to the URL. + +Returns @Right a@ on success with parsed JSON response, +or @Left TodoistError@ on failure. +-} +apiGet :: + forall a b. + (FromJSON a) => Proxy a -> TodoistConfig -> TodoistRequest b -> IO (Either TodoistError a) +apiGet _ config request = do + let reqfn = Http.req Http.GET scheme Http.NoReqBody (Http.jsonResponse @a) header' + + responseEither <- try @Http.HttpException $ Http.runReq Http.defaultHttpConfig reqfn + + case responseEither of + Right r -> (pure . pure) $ Http.responseBody r + Left l -> pure $ handleException l + where + scheme = getScheme request + params = mconcat $ L.map (\(key, val) -> (key =: val) :: Http.Option Http.Https) (_queryParams request) + header' = getAuthHeader config <> params + +{- | Perform a POST request to the Todoist API + +Unified POST request function that handles all combinations of: + +- Request body: 'Nothing' (no body) or 'Just b' (JSON body) +- Response handling: 'IgnoreResponse' or 'JsonResponse' (parse JSON) + +Returns @Right responseBody@ on success (or @Right ()@ if ignoring response), +or @Left TodoistError@ on failure. + +The 'PostResponse' GADT ensures type safety between response handling strategy +and return type. +-} +apiPost :: + forall requestBody responseBody b. + (ToJSON requestBody) => + Maybe requestBody -> + PostResponse responseBody -> + TodoistConfig -> + TodoistRequest b -> + IO (Either TodoistError responseBody) +apiPost maybeBody responseSpec config request = + case (maybeBody, responseSpec) of + (Nothing, IgnoreResponse) -> do + let reqfn = Http.req Http.POST scheme Http.NoReqBody Http.ignoreResponse header' + handleResponse reqfn + (Nothing, JsonResponse (_ :: Proxy responseBody)) -> do + let reqfn = Http.req Http.POST scheme Http.NoReqBody (Http.jsonResponse @responseBody) header' + handleResponse reqfn + (Just body, IgnoreResponse) -> do + let reqfn = Http.req Http.POST scheme (Http.ReqBodyJson body) Http.ignoreResponse header' + handleResponse reqfn + (Just body, JsonResponse (_ :: Proxy responseBody)) -> do + let reqfn = Http.req Http.POST scheme (Http.ReqBodyJson body) (Http.jsonResponse @responseBody) header' + handleResponse reqfn + where + scheme = getScheme request + header' = getAuthHeader config + + handleResponse reqfn = do + responseEither <- try @Http.HttpException $ Http.runReq Http.defaultHttpConfig reqfn + case responseEither of + Right response -> (pure . pure) $ Http.responseBody response + Left l -> pure $ handleException l + +{- | Perform a DELETE request to the Todoist API + +Makes an authenticated DELETE request to remove a resource. +Always ignores the response body and returns @()@ on success. + +Returns @Right ()@ on successful deletion, +or @Left TodoistError@ on failure. +-} +apiDelete :: forall b. TodoistConfig -> TodoistRequest b -> IO (Either TodoistError ()) +apiDelete config request = do + let reqfn = Http.req Http.DELETE scheme Http.NoReqBody Http.ignoreResponse header' + responseEither <- try @Http.HttpException $ Http.runReq Http.defaultHttpConfig reqfn + + case responseEither of + Right response -> (pure . pure) $ Http.responseBody response + Left l -> pure $ handleException l + where + scheme = getScheme request + header' = getAuthHeader config + +{- | Build authentication and content-type headers for API requests + +Constructs HTTP headers for Todoist API requests: + +- @Authorization@: Bearer token authentication (redacted in logs) +- @Content-Type@: @application\/json@ +- @Accept@: @application\/json@ + +All API requests require these headers for proper authentication and +content negotiation. +-} +getAuthHeader :: TodoistConfig -> Http.Option Http.Https +getAuthHeader config = + Http.headerRedacted "Authorization" ("Bearer " <> getAuthToken (authToken config)) + <> Http.header "Content-Type" "application/json" + <> Http.header "Accept" "application/json" + +handleException :: Http.HttpException -> Either TodoistError responseBody +handleException e = + case Http.isStatusCodeException e of + Just sce -> case Http.responseStatusCode sce of + 400 -> Left BadRequest + 401 -> Left Unauthorized + 403 -> Left Forbidden + 404 -> Left NotFound + code -> Left $ HttpError ("HTTP status code: " <> show code) + Nothing -> Left $ HttpError ("HTTP error: " <> show e) diff --git a/src/internal/Web/Todoist/Internal/Json.hs b/src/internal/Web/Todoist/Internal/Json.hs new file mode 100644 --- /dev/null +++ b/src/internal/Web/Todoist/Internal/Json.hs @@ -0,0 +1,37 @@ +{- | +Module : Web.Todoist.Internal.Json +Description : JSON serialization utilities for Todoist API types +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +Internal module providing JSON serialization utilities for Todoist API types. + +The codebase uses a two-layer JSON serialization strategy: + +1. HTTP Response Types use @p_@ prefix (e.g., @p_id@, @p_name@) and serialize + using 'jsonOpts' which drops 2 characters +2. Domain Request/Response Types use @_@ prefix (e.g., @_id@, @_name@) and + serialize using @fieldLabelModifier = drop 1@ + +This module provides the standardized options for the HTTP layer. +-} +module Web.Todoist.Internal.Json + ( jsonOpts + ) where + +import Data.Aeson (Options, defaultOptions, fieldLabelModifier, omitNothingFields) +import Data.Bool (Bool (True)) +import qualified Data.List as L + +{- | Standard JSON options for HTTP response types + +Applies two transformations: + +1. Drops first 2 characters from field names (the @p_@ prefix) +2. Omits @Nothing@ fields from JSON output for partial updates + +Example: @p_id@ becomes @\"id\"@ in JSON, @p_name@ becomes @\"name\"@ +-} +jsonOpts :: Options +jsonOpts = defaultOptions {fieldLabelModifier = L.drop 2, omitNothingFields = True} diff --git a/src/internal/Web/Todoist/Internal/Request.hs b/src/internal/Web/Todoist/Internal/Request.hs new file mode 100644 --- /dev/null +++ b/src/internal/Web/Todoist/Internal/Request.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE DataKinds #-} + +{- | +Module : Web.Todoist.Internal.Request +Description : Request building utilities for Todoist API +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +Internal module for building HTTP requests to the Todoist REST API. +Provides types and functions for constructing properly formatted API requests +with endpoints, query parameters, and request bodies. + +All requests use the base URL @https:\/\/api.todoist.com\/api\/v1@. +-} +module Web.Todoist.Internal.Request + ( TodoistRequest (..) + , mkTodoistRequest + , getScheme + ) where + +import Web.Todoist.Internal.Types (Endpoint, Params) + +import qualified Data.List as L +import Data.Maybe (Maybe (..), fromMaybe) +import Data.Monoid ((<>)) +import Data.Text (Text) +import Network.HTTP.Req ((/:)) +import qualified Network.HTTP.Req as Http + +{- | Represents an HTTP request to the Todoist API + +Contains all components needed to make an API request: + +- Domain: @api.todoist.com@ +- Endpoint: Path segments like @[\"projects\", \"12345\"]@ +- Query parameters: Optional key-value pairs for filtering/pagination +- Request body: Optional JSON payload for POST requests +-} +data TodoistRequest body = TodoistRequest + { _domain :: Text + , _endpoint :: Endpoint + , _queryParams :: Params + , _requestBody :: Maybe body + } + +{- | Construct a Todoist API request with the given components + +Automatically prepends @["api", "v1"]@ to the endpoint path and sets +the domain to @api.todoist.com@. + +Example: + +@ +mkTodoistRequest [\"projects\"] Nothing Nothing +-- Creates request to: https:\/\/api.todoist.com\/api\/v1\/projects +@ +-} +mkTodoistRequest :: Endpoint -> Maybe Params -> Maybe body -> TodoistRequest body +mkTodoistRequest endpoint params body = + TodoistRequest + { _domain = "api.todoist.com" + , _endpoint = ["api", "v1"] <> endpoint + , _queryParams = fromMaybe [] params + , _requestBody = body + } + +{- | Build the HTTPS URL from a request + +Constructs the complete HTTPS URL by combining the domain and endpoint path. +Used by the HTTP layer to create the final request URL. +-} +getScheme :: TodoistRequest body -> Http.Url Http.Https +getScheme request = L.foldl (/:) (Http.https (_domain request)) (_endpoint request) diff --git a/src/internal/Web/Todoist/Internal/Types.hs b/src/internal/Web/Todoist/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/internal/Web/Todoist/Internal/Types.hs @@ -0,0 +1,530 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} + +{- | +Module : Web.Todoist.Internal.Types +Description : Internal HTTP response types for Todoist REST API +Copyright : (c) 2025 Sam S. Almahri +License : MIT +Maintainer : sam.salmahri@gmail.com + +Internal module defining HTTP response types that mirror the Todoist REST API +JSON responses. These types use the @p_@ field prefix convention and are +converted to domain types for public use. + +This module is part of the internal HTTP layer. End users should use the +domain types from "Web.Todoist.Domain.*" modules instead. + += Field Naming Convention + +HTTP response types use @p_@ prefix (e.g., @p_id@, @p_name@) which is dropped +by 'jsonOpts' during serialization. This allows clean JSON field names while +avoiding conflicts with domain types that use @_@ prefix. +-} +module Web.Todoist.Internal.Types + ( TodoistReturn (..) + , ProjectResponse (..) + , CreatedAt (..) + , UpdatedAt (..) + , CreatorUid (..) + , Role (..) + , ParentId (..) + , ProjectAccessView (..) + , ProjectVisibility (..) + , CollaboratorRole (..) + , Action (..) + , RoleActions (..) + , ProjectPermissions (..) + , TaskResponse (..) + , DurationResponse (..) + , DeadlineResponse (..) + , DueResponse (..) + , NewTaskResponse (..) + , CommentResponse (..) + , SectionResponse (..) + , LabelResponse (..) + , FileAttachment (..) + , Reactions (..) + , Params + , Endpoint + ) where + +import Web.Todoist.Internal.Json (jsonOpts) + +import Control.Applicative (pure) +import Control.Monad.Fail (fail) +import Data.Aeson + ( FromJSON (parseJSON) + , ToJSON (toJSON) + , Value (String) + , genericParseJSON + , genericToJSON + , withText + ) +import Data.Aeson.Types (Parser) +import Data.Bool (Bool) +import Data.Eq (Eq) +import Data.Function (($)) +import Data.Int (Int) +import Data.Maybe (Maybe (Just, Nothing)) +import Data.Semigroup ((<>)) +import Data.String (String) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) +import Text.Show (Show) + +-- | Wrapper type for paginated API responses +data TodoistReturn a = TodoistReturn + { results :: [a] + , next_cursor :: Maybe String + } + deriving (Show, Generic, ToJSON, FromJSON) + +-- | Type alias for query parameters (key-value pairs) +type Params = [(Text, Text)] + +-- | Type alias for API endpoint path segments +type Endpoint = [Text] + +{- | HTTP API response type for GET project endpoint +This represents the complete JSON response returned by the Todoist REST API +when retrieving a project. Field names use p_ prefix which is dropped by jsonOpts. +-} +data ProjectResponse = ProjectResponse + { p_id :: Text + , p_can_assign_tasks :: Bool + , p_child_order :: Int + , p_color :: Text + , p_creator_uid :: CreatorUid + , p_created_at :: CreatedAt + , p_is_archived :: Bool + , p_is_deleted :: Bool + , p_is_favorite :: Bool + , p_is_frozen :: Bool + , p_name :: Text + , p_updated_at :: UpdatedAt -- TODO: use Maybe Text + , p_view_style :: Text + , p_default_order :: Int + , p_description :: Text + , p_public_key :: Text + , p_access :: Maybe ProjectAccessView + , p_role :: Role + , p_parent_id :: ParentId + , p_inbox_project :: Bool + , p_is_collapsed :: Bool + , p_is_shared :: Bool + } + deriving (Show, Generic) + +instance FromJSON ProjectResponse where + parseJSON :: Value -> Parser ProjectResponse + parseJSON = genericParseJSON jsonOpts + +instance ToJSON ProjectResponse where + toJSON :: ProjectResponse -> Value + toJSON = genericToJSON jsonOpts + +newtype CreatorUid = CreatorUid + { p_creator_uid :: Maybe Text + } + deriving (Show, Generic) + +instance FromJSON CreatorUid where + parseJSON :: Value -> Parser CreatorUid + parseJSON = \case + String txt -> pure $ CreatorUid (Just txt) + _ -> pure $ CreatorUid Nothing + +instance ToJSON CreatorUid where + toJSON :: CreatorUid -> Value + toJSON (CreatorUid Nothing) = String "" + toJSON (CreatorUid (Just txt)) = String txt + +newtype CreatedAt = CreatedAt + { p_created_at :: Maybe Text + } + deriving (Show, Generic) + +instance FromJSON CreatedAt where + parseJSON :: Value -> Parser CreatedAt + parseJSON = \case + String txt -> pure $ CreatedAt (Just txt) + _ -> pure $ CreatedAt Nothing + +instance ToJSON CreatedAt where + toJSON :: CreatedAt -> Value + toJSON (CreatedAt Nothing) = String "" + toJSON (CreatedAt (Just txt)) = String txt + +newtype UpdatedAt = UpdatedAt + { p_updated_at :: Maybe Text + } + deriving (Show, Generic, Eq) + +instance FromJSON UpdatedAt where + parseJSON :: Value -> Parser UpdatedAt + parseJSON = \case + String txt -> pure $ UpdatedAt (Just txt) + _ -> pure $ UpdatedAt Nothing + +instance ToJSON UpdatedAt where + toJSON :: UpdatedAt -> Value + toJSON (UpdatedAt Nothing) = String "" + toJSON (UpdatedAt (Just txt)) = String txt + +newtype Role = Role + { p_role :: Maybe Text + } + deriving (Show, Generic) + +instance FromJSON Role where + parseJSON :: Value -> Parser Role + parseJSON = \case + String txt -> pure $ Role (Just txt) + _ -> pure $ Role Nothing + +instance ToJSON Role where + toJSON :: Role -> Value + toJSON (Role Nothing) = String "" + toJSON (Role (Just txt)) = String txt + +newtype ParentId = ParentId + { p_parent_id :: Maybe Text + } + deriving (Show, Generic) + +instance FromJSON ParentId where + parseJSON :: Value -> Parser ParentId + parseJSON = \case + String txt -> pure $ ParentId (Just txt) + _ -> pure $ ParentId Nothing + +instance ToJSON ParentId where + toJSON :: ParentId -> Value + toJSON (ParentId Nothing) = String "" + toJSON (ParentId (Just txt)) = String txt + +data ProjectAccessView = ProjectAccessView + { p_visibility :: ProjectVisibility + , p_configuration :: Value + } + deriving (Show, Generic) + +instance FromJSON ProjectAccessView where + parseJSON :: Value -> Parser ProjectAccessView + parseJSON = genericParseJSON jsonOpts + +instance ToJSON ProjectAccessView where + toJSON :: ProjectAccessView -> Value + toJSON = genericToJSON jsonOpts + +data ProjectVisibility = Restricted | Team | Public deriving (Show, Generic) + +instance FromJSON ProjectVisibility where + parseJSON :: Value -> Parser ProjectVisibility + parseJSON = withText "ProjectVisibility" $ \case + "restricted" -> pure Restricted + "team" -> pure Team + "public" -> pure Public + _ -> fail "Unknown ProjectVisibility value" + +instance ToJSON ProjectVisibility where + toJSON :: ProjectVisibility -> Value + toJSON Restricted = String "restricted" + toJSON Team = String "team" + toJSON Public = String "public" + +{- | Collaborator role enum. Represents different permission levels +for project collaborators. +-} +data CollaboratorRole = Creator | Admin | Member | ReadWrite | ReadOnly + deriving (Show, Eq, Generic) + +instance FromJSON CollaboratorRole where + parseJSON :: Value -> Parser CollaboratorRole + parseJSON = withText "CollaboratorRole" $ \case + "CREATOR" -> pure Creator + "ADMIN" -> pure Admin + "MEMBER" -> pure Member + "READ_WRITE" -> pure ReadWrite + "READ_ONLY" -> pure ReadOnly + other -> fail $ "Unknown collaborator role: " <> T.unpack other + +instance ToJSON CollaboratorRole where + toJSON :: CollaboratorRole -> Value + toJSON Creator = String "CREATOR" + toJSON Admin = String "ADMIN" + toJSON Member = String "MEMBER" + toJSON ReadWrite = String "READ_WRITE" + toJSON ReadOnly = String "READ_ONLY" + +{- | An action that can be performed by a collaborator role. +Action names are kept as Text for maximum flexibility as the API +may add new action types without warning. +-} +newtype Action = Action + { p_name :: Text + } + deriving (Show, Eq, Generic) + +instance FromJSON Action where + parseJSON :: Value -> Parser Action + parseJSON = genericParseJSON jsonOpts + +instance ToJSON Action where + toJSON :: Action -> Value + toJSON = genericToJSON jsonOpts + +-- | A role with its associated list of allowed actions. +data RoleActions = RoleActions + { p_name :: CollaboratorRole + -- ^ The collaborator role (e.g., Creator) + , p_actions :: [Action] + -- ^ Actions this role can perform + } + deriving (Show, Eq, Generic) + +instance FromJSON RoleActions where + parseJSON :: Value -> Parser RoleActions + parseJSON = genericParseJSON jsonOpts + +instance ToJSON RoleActions where + toJSON :: RoleActions -> Value + toJSON = genericToJSON jsonOpts + +{- | Top-level permissions response from GET /api/v1/projects/permissions. +Contains role-action mappings for both project and workspace collaborators. +-} +data ProjectPermissions = ProjectPermissions + { p_project_collaborator_actions :: [RoleActions] + , p_workspace_collaborator_actions :: [RoleActions] + } + deriving (Show, Eq, Generic) + +instance FromJSON ProjectPermissions where + parseJSON :: Value -> Parser ProjectPermissions + parseJSON = genericParseJSON jsonOpts + +instance ToJSON ProjectPermissions where + toJSON :: ProjectPermissions -> Value + toJSON = genericToJSON jsonOpts + +-- | Duration information for a task (API response version) +data DurationResponse = DurationResponse + { p_amount :: Int + , p_unit :: Text + } + deriving (Show, Eq, Generic) + +instance FromJSON DurationResponse where + parseJSON :: Value -> Parser DurationResponse + parseJSON = genericParseJSON jsonOpts + +instance ToJSON DurationResponse where + toJSON :: DurationResponse -> Value + toJSON = genericToJSON jsonOpts + +-- | Deadline information for a task (API response version) +data DeadlineResponse = DeadlineResponse + { p_date :: Text + , p_lang :: Text + } + deriving (Show, Eq, Generic) + +instance FromJSON DeadlineResponse where + parseJSON :: Value -> Parser DeadlineResponse + parseJSON = genericParseJSON jsonOpts + +instance ToJSON DeadlineResponse where + toJSON :: DeadlineResponse -> Value + toJSON = genericToJSON jsonOpts + +-- | Due date information for a task (API response version) +data DueResponse = DueResponse + { p_date :: Text + , p_string :: Text + , p_lang :: Text + , p_is_recurring :: Bool + , p_timezone :: Maybe Text + } + deriving (Show, Eq, Generic) + +instance FromJSON DueResponse where + parseJSON :: Value -> Parser DueResponse + parseJSON = genericParseJSON jsonOpts + +instance ToJSON DueResponse where + toJSON :: DueResponse -> Value + toJSON = genericToJSON jsonOpts + +{- | HTTP API response type for task endpoints +This represents the complete JSON response returned by the Todoist REST API +when retrieving or manipulating tasks. Field names use p_ prefix which is dropped by jsonOpts. +-} +data TaskResponse = TaskResponse + { p_user_id :: Text + , p_id :: Text + , p_project_id :: Text + , p_section_id :: Maybe Text + , p_parent_id :: Maybe Text + , p_added_by_uid :: Maybe Text + , p_assigned_by_uid :: Maybe Text + , p_responsible_uid :: Maybe Text + , p_labels :: [Text] + , p_deadline :: Maybe DeadlineResponse + , p_duration :: Maybe DurationResponse + , p_checked :: Bool + , p_is_deleted :: Bool + , p_added_at :: Maybe Text + , p_completed_at :: Maybe Text + , p_updated_at :: Maybe Text + , p_due :: Maybe DueResponse + , p_priority :: Int + , p_child_order :: Int + , p_content :: Text + , p_description :: Text + , p_note_count :: Int + , p_day_order :: Int + , p_is_collapsed :: Bool + } + deriving (Show, Eq, Generic) + +instance FromJSON TaskResponse where + parseJSON :: Value -> Parser TaskResponse + parseJSON = genericParseJSON jsonOpts + +instance ToJSON TaskResponse where + toJSON :: TaskResponse -> Value + toJSON = genericToJSON jsonOpts + +data NewTaskResponse = NewTaskResponse + { p_user_id :: Text + , p_id :: Text + , p_project_id :: Text + , p_section_id :: Maybe Text + , p_parent_id :: Maybe Text + , p_added_by_uid :: Maybe Text + , p_assigned_by_uid :: Maybe Text + , p_responsible_uid :: Maybe Text + , p_labels :: [Text] + , p_checked :: Bool + , p_is_deleted :: Bool + , p_added_at :: Maybe Text + , p_completed_at :: Maybe Text + , p_updated_at :: Maybe Text + , p_priority :: Int + , p_child_order :: Int + , p_content :: Text + , p_description :: Text + , p_note_count :: Int + , p_day_order :: Int + , p_is_collapsed :: Bool + } + deriving (Show, Generic) + +instance FromJSON NewTaskResponse where + parseJSON :: Value -> Parser NewTaskResponse + parseJSON = genericParseJSON jsonOpts + +instance ToJSON NewTaskResponse where + toJSON :: NewTaskResponse -> Value + toJSON = genericToJSON jsonOpts + +-- | File attachment in comment response +data FileAttachment = FileAttachment + { p_file_name :: Text + , p_file_type :: Text + , p_file_url :: Text + , p_resource_type :: Text + } + deriving (Show, Eq, Generic) + +instance FromJSON FileAttachment where + parseJSON :: Value -> Parser FileAttachment + parseJSON = genericParseJSON jsonOpts + +instance ToJSON FileAttachment where + toJSON :: FileAttachment -> Value + toJSON = genericToJSON jsonOpts + +-- | Reactions data (opaque object for now) +newtype Reactions = Reactions {p_reactions :: Value} + deriving (Show, Eq, Generic) + +instance FromJSON Reactions where + parseJSON :: Value -> Parser Reactions + parseJSON v = pure $ Reactions {p_reactions = v} + +instance ToJSON Reactions where + toJSON :: Reactions -> Value + toJSON (Reactions r) = r + +-- | HTTP response type for Comment API (contains all fields from API) +data CommentResponse = CommentResponse + { p_id :: Text + , p_content :: Text + , p_posted_uid :: Maybe Text + , p_posted_at :: Maybe Text + , p_item_id :: Maybe Text -- Maps to task_id in domain + , p_project_id :: Maybe Text + , p_file_attachment :: Maybe FileAttachment -- Maps to attachment in domain + , p_uids_to_notify :: Maybe [Text] + , p_is_deleted :: Bool + , p_reactions :: Maybe Reactions + } + deriving (Show, Generic) + +instance FromJSON CommentResponse where + parseJSON :: Value -> Parser CommentResponse + parseJSON = genericParseJSON jsonOpts + +instance ToJSON CommentResponse where + toJSON :: CommentResponse -> Value + toJSON = genericToJSON jsonOpts + +{- | HTTP response type for Section endpoints +Uses p_ prefix which gets dropped by jsonOpts (drops 2 chars) +-} +data SectionResponse = SectionResponse + { p_id :: Text + , p_user_id :: Text + , p_project_id :: Text + , p_added_at :: Text + , p_updated_at :: Maybe Text + , p_archived_at :: Maybe Text + , p_name :: Text + , p_section_order :: Int + , p_is_archived :: Bool + , p_is_deleted :: Bool + , p_is_collapsed :: Bool + } + deriving (Show, Generic) + +instance FromJSON SectionResponse where + parseJSON :: Value -> Parser SectionResponse + parseJSON = genericParseJSON jsonOpts + +instance ToJSON SectionResponse where + toJSON :: SectionResponse -> Value + toJSON = genericToJSON jsonOpts + +-- | HTTP API response type for GET label endpoint +data LabelResponse = LabelResponse + { p_id :: Text + , p_name :: Text + , p_color :: Text + , p_order :: Maybe Int + , p_is_favorite :: Bool + } + deriving (Show, Generic) + +instance FromJSON LabelResponse where + parseJSON :: Value -> Parser LabelResponse + parseJSON = genericParseJSON jsonOpts + +instance ToJSON LabelResponse where + toJSON :: LabelResponse -> Value + toJSON = genericToJSON jsonOpts diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/Web/Todoist/BuilderSpec.hs b/test/Web/Todoist/BuilderSpec.hs new file mode 100644 --- /dev/null +++ b/test/Web/Todoist/BuilderSpec.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Web.Todoist.BuilderSpec (spec) where + +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) +import Web.Todoist.Domain.Project (ProjectCreate, createProjectBuilder) +import Web.Todoist.Util.Builder + ( Builder + , runBuilder + , withDescription + , withParentId + ) + +import Data.Aeson (encode) +import Data.Bool (Bool (True)) +import Data.Function (($)) +import Data.Monoid (Monoid (mempty), (<>)) +import GHC.Base (const) + +spec :: Spec +spec = do + describe "Builder Monoid instance" $ do + it "satisfies left identity: mempty <> x = x" $ do + let x = withDescription "test" <> withParentId "parent123" + let seed = createProjectBuilder "Project" + encode (runBuilder seed (mempty <> x)) `shouldBe` encode (runBuilder seed x) + + it "satisfies right identity: x <> mempty = x" $ do + let x = withDescription "test" <> withParentId "parent123" + let seed = createProjectBuilder "Project" + encode (runBuilder seed (x <> mempty)) `shouldBe` encode (runBuilder seed x) + + it "satisfies associativity: (x <> y) <> z = x <> (y <> z)" $ do + let x = withDescription "desc" + let y = withParentId "parent1" + let z = withParentId "parent2" + let seed = createProjectBuilder "Project" + encode (runBuilder seed ((x <> y) <> z)) `shouldBe` encode (runBuilder seed (x <> (y <> z))) + + it "mempty is the identity modification" $ do + let seed = createProjectBuilder "Project" + encode (runBuilder seed mempty) + `shouldBe` encode (runBuilder seed (mempty :: Builder ProjectCreate)) + + describe "Builder usage patterns" $ do + it "can use mempty when no modifications needed" $ do + let seed = createProjectBuilder "Project" + let result = runBuilder seed mempty + result `shouldSatisfy` const True -- Just verify it compiles and runs + it "can compose multiple modifications" $ do + let seed = createProjectBuilder "Project" + let mods = withDescription "desc" <> withParentId "parent123" + let result = runBuilder seed mods + result `shouldSatisfy` const True diff --git a/test/Web/Todoist/Runner/TodoistIO/CommentSpec.hs b/test/Web/Todoist/Runner/TodoistIO/CommentSpec.hs new file mode 100644 --- /dev/null +++ b/test/Web/Todoist/Runner/TodoistIO/CommentSpec.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE RecordWildCards #-} + +module Web.Todoist.Runner.TodoistIO.CommentSpec (spec) where + +import Web.Todoist.Domain.Comment (Comment (..), CommentId (..), Content (..)) +import Web.Todoist.Domain.Types (ProjectId (..), TaskId (..), Uid (..)) +import Web.Todoist.Internal.Types (CommentResponse (..)) +import Web.Todoist.Runner.IO.Interpreters (commentResponseToComment) +import Web.Todoist.TestHelpers + ( sampleCommentResponse + , sampleCommentResponseJson + , sampleCommentResponseWithAttachment + , sampleCommentResponseWithAttachmentJson + ) + +import Data.Aeson (decode, eitherDecode) +import Data.Bool (Bool (False)) +import Data.Either (Either (Right), isLeft, isRight) +import Data.Function (($)) +import Data.Maybe (Maybe (..), fromJust, isJust) +import Data.String (String) +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) + +spec :: Spec +spec = do + describe "Comment JSON Parsing" $ do + commentResponseJsonParsingSpec + commentResponseWithAttachmentJsonParsingSpec + commentResponseToCommentSpec + commentResponseToCommentValidationSpec + +commentResponseJsonParsingSpec :: Spec +commentResponseJsonParsingSpec = describe "CommentResponse JSON parsing" $ do + it "parses CommentResponse JSON correctly" $ do + let decodedEither = eitherDecode sampleCommentResponseJson :: Either String CommentResponse + decodedEither `shouldSatisfy` isRight + + let decoded = decode sampleCommentResponseJson :: Maybe CommentResponse + decoded `shouldSatisfy` isJust + + let CommentResponse {..} = fromJust decoded + p_id `shouldBe` "3012345678" + p_content `shouldBe` "This is a test comment" + p_posted_uid `shouldBe` Just "2671355" + p_posted_at `shouldBe` Just "2023-10-15T14:30:00Z" + p_item_id `shouldBe` Nothing + p_project_id `shouldBe` Just "2203306141" + p_file_attachment `shouldBe` Nothing + p_is_deleted `shouldBe` False + +commentResponseWithAttachmentJsonParsingSpec :: Spec +commentResponseWithAttachmentJsonParsingSpec = describe "CommentResponse with attachment JSON parsing" $ do + it "parses CommentResponse with attachment JSON correctly" $ do + let decodedEither = eitherDecode sampleCommentResponseWithAttachmentJson :: Either String CommentResponse + decodedEither `shouldSatisfy` isRight + + let decoded = decode sampleCommentResponseWithAttachmentJson :: Maybe CommentResponse + decoded `shouldSatisfy` isJust + + let CommentResponse {..} = fromJust decoded + p_id `shouldBe` "3012345679" + p_content `shouldBe` "Comment with attachment" + p_file_attachment `shouldSatisfy` isJust + p_item_id `shouldBe` Just "2995104339" + p_project_id `shouldBe` Nothing + +commentResponseToCommentSpec :: Spec +commentResponseToCommentSpec = describe "commentResponseToComment conversion" $ do + it "converts CommentResponse to Comment correctly" $ do + let result = commentResponseToComment sampleCommentResponse + result `shouldSatisfy` isRight + + let Right (Comment {..}) = result + _id `shouldBe` CommentId "3012345678" + _content `shouldBe` Content "This is a test comment" + _poster_id `shouldBe` Just (Uid "2671355") + _posted_at `shouldBe` Just (Uid "2023-10-15T14:30:00Z") + _task_id `shouldBe` Nothing + _project_id `shouldBe` Just (ProjectId "2203306141") + _attachment `shouldBe` Nothing + + it "converts CommentResponse with attachment to Comment correctly" $ do + let result = commentResponseToComment sampleCommentResponseWithAttachment + result `shouldSatisfy` isRight + + let Right (Comment {..}) = result + _id `shouldBe` CommentId "3012345679" + _task_id `shouldBe` Just (TaskId "2995104339") + _project_id `shouldBe` Nothing + _attachment `shouldSatisfy` isJust + +commentResponseToCommentValidationSpec :: Spec +commentResponseToCommentValidationSpec = describe "commentResponseToComment validation" $ do + it "fails conversion when both task_id and project_id are Nothing" $ do + let invalidResponse = sampleCommentResponse {p_item_id = Nothing, p_project_id = Nothing} + result = commentResponseToComment invalidResponse + result `shouldSatisfy` isLeft diff --git a/test/Web/Todoist/Runner/TodoistIO/LabelSpec.hs b/test/Web/Todoist/Runner/TodoistIO/LabelSpec.hs new file mode 100644 --- /dev/null +++ b/test/Web/Todoist/Runner/TodoistIO/LabelSpec.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE DisambiguateRecordFields #-} + +module Web.Todoist.Runner.TodoistIO.LabelSpec (spec) where + +import Data.Aeson (decode, eitherDecode) +import Data.Bool (Bool (False)) +import Data.Either (Either, isRight) +import Data.Function (($)) +import Data.Maybe (Maybe (Just, Nothing), fromJust, isJust) +import Data.String (String) +import Data.Text (Text) +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) + +import Web.Todoist.Domain.Label (Label (..), LabelId (..)) +import Web.Todoist.Domain.Types (Color (..), IsFavorite (..), Name (..), Order (..)) +import Web.Todoist.Internal.Types (LabelResponse (..), TodoistReturn (..)) +import Web.Todoist.TestHelpers + ( sampleLabel + , sampleLabelResponseJson + , sampleLabelsJson + , sampleSharedLabelsJson + ) + +spec :: Spec +spec = do + describe "LabelResponse JSON parsing" $ do + it "parses valid LabelResponse JSON" $ do + let result = eitherDecode sampleLabelResponseJson :: Either String LabelResponse + result `shouldSatisfy` isRight + + it "correctly parses all fields from JSON" $ do + let decoded = decode sampleLabelResponseJson :: Maybe LabelResponse + decoded `shouldSatisfy` isJust + let response = fromJust decoded + LabelResponse + { p_id = pId + , p_name = pName + , p_color = pColor + , p_order = pOrder + , p_is_favorite = pFavorite + } = response + pId `shouldBe` ("label123" :: Text) + pName `shouldBe` ("Test Label" :: Text) + pColor `shouldBe` ("charcoal" :: Text) + pOrder `shouldBe` Just 1 + pFavorite `shouldBe` False + + describe "TodoistReturn LabelResponse JSON parsing" $ do + it "parses paginated labels response" $ do + let result = eitherDecode sampleLabelsJson :: Either String (TodoistReturn LabelResponse) + result `shouldSatisfy` isRight + + it "correctly parses results and cursor" $ do + let decoded = decode sampleLabelsJson :: Maybe (TodoistReturn LabelResponse) + decoded `shouldSatisfy` isJust + let response = fromJust decoded + TodoistReturn {next_cursor = cursor} = response + cursor `shouldBe` Nothing + + describe "TodoistReturn Text JSON parsing (shared labels)" $ do + it "parses shared labels response" $ do + let result = eitherDecode sampleSharedLabelsJson :: Either String (TodoistReturn Text) + result `shouldSatisfy` isRight + + it "correctly parses string array results" $ do + let decoded = decode sampleSharedLabelsJson :: Maybe (TodoistReturn Text) + decoded `shouldSatisfy` isJust + let response = fromJust decoded + TodoistReturn {results = names, next_cursor = cursor} = response + names `shouldBe` ["Label1", "Label2", "Label3"] + cursor `shouldBe` Nothing + + describe "LabelId JSON serialization" $ do + it "deserializes LabelId correctly from object" $ do + let encoded = eitherDecode "{\"id\":\"label123\"}" :: Either String LabelId + encoded `shouldSatisfy` isRight + let labelId = fromJust $ decode "{\"id\":\"label123\"}" + LabelId {getLabelId = lidId} = labelId + lidId `shouldBe` ("label123" :: Text) + + describe "Label domain type" $ do + it "has correct field values" $ do + let Label + { _id = labId + , _name = labName + , _color = labColor + , _order = labOrder + , _is_favorite = labFavorite + } = sampleLabel + labId `shouldBe` LabelId "label123" + labName `shouldBe` Name "Test Label" + labColor `shouldBe` Color "charcoal" + labOrder `shouldBe` Just (Order 1) + labFavorite `shouldBe` IsFavorite False diff --git a/test/Web/Todoist/Runner/TodoistIO/SectionSpec.hs b/test/Web/Todoist/Runner/TodoistIO/SectionSpec.hs new file mode 100644 --- /dev/null +++ b/test/Web/Todoist/Runner/TodoistIO/SectionSpec.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE DisambiguateRecordFields #-} + +module Web.Todoist.Runner.TodoistIO.SectionSpec (spec) where + +import Data.Aeson (decode, eitherDecode) +import Data.Either (Either, isRight) +import Data.Maybe (Maybe (Just, Nothing), fromJust, isJust) +import Data.Text (Text) +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) + +import Data.Bool (Bool (False)) +import Data.Function (($)) +import Data.String (String) +import Web.Todoist.Domain.Section (Section (..), SectionId (..)) +import Web.Todoist.Domain.Types (IsCollapsed (..), Name (..), Order (..), ProjectId (..)) +import Web.Todoist.Internal.Types (SectionResponse (..), TodoistReturn (..)) +import Web.Todoist.TestHelpers + ( sampleSection + , sampleSectionResponseJson + , sampleSectionsJson + ) + +spec :: Spec +spec = do + describe "SectionResponse JSON parsing" $ do + it "parses valid SectionResponse JSON" $ do + let result = eitherDecode sampleSectionResponseJson :: Either String SectionResponse + result `shouldSatisfy` isRight + + it "correctly parses all fields from JSON" $ do + let decoded = decode sampleSectionResponseJson :: Maybe SectionResponse + decoded `shouldSatisfy` isJust + let response = fromJust decoded + SectionResponse + { p_id = pId + , p_name = pName + , p_project_id = pProjectId + , p_section_order = pOrder + , p_is_collapsed = pCollapsed + , p_is_archived = pArchived + , p_is_deleted = pDeleted + , p_updated_at = pUpdatedAt + , p_archived_at = pArchivedAt + } = response + pId `shouldBe` ("section123" :: Text) + pName `shouldBe` ("Test Section" :: Text) + pProjectId `shouldBe` ("project789" :: Text) + pOrder `shouldBe` 1 + pCollapsed `shouldBe` False + pArchived `shouldBe` False + pDeleted `shouldBe` False + pUpdatedAt `shouldBe` Just "2024-01-02T14:30:00Z" + pArchivedAt `shouldBe` Nothing + + describe "TodoistReturn SectionResponse JSON parsing" $ do + it "parses paginated sections response" $ do + let result = eitherDecode sampleSectionsJson :: Either String (TodoistReturn SectionResponse) + result `shouldSatisfy` isRight + + it "correctly parses results and cursor" $ do + let decoded = decode sampleSectionsJson :: Maybe (TodoistReturn SectionResponse) + decoded `shouldSatisfy` isJust + let response = fromJust decoded + TodoistReturn {next_cursor = cursor} = response + cursor `shouldBe` Nothing + + describe "SectionId JSON serialization" $ do + it "serializes SectionId correctly" $ do + let encoded = eitherDecode "{\"id\":\"section123\"}" :: Either String SectionId + encoded `shouldSatisfy` isRight + let sectionId = fromJust $ decode "{\"id\":\"section123\"}" + SectionId {_id = sidId} = sectionId + sidId `shouldBe` ("section123" :: Text) + + describe "Section domain type" $ do + it "has correct field values" $ do + let Section + { _id = secId + , _name = secName + , _project_id = secProjId + , _order = secOrder + , _is_collapsed = secCollapsed + } = sampleSection + secId `shouldBe` SectionId {_id = "section123"} + secName `shouldBe` Name "Test Section" + secProjId `shouldBe` ProjectId "project789" + secOrder `shouldBe` Order 1 + secCollapsed `shouldBe` IsCollapsed False diff --git a/test/Web/Todoist/Runner/TodoistIO/TaskSpec.hs b/test/Web/Todoist/Runner/TodoistIO/TaskSpec.hs new file mode 100644 --- /dev/null +++ b/test/Web/Todoist/Runner/TodoistIO/TaskSpec.hs @@ -0,0 +1,324 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Web.Todoist.Runner.TodoistIO.TaskSpec (spec) where + +import Web.Todoist.Domain.Section (SectionId (..)) +import Web.Todoist.Domain.Task + ( Deadline (..) + , Due (..) + , Duration (..) + , DurationUnit (..) + , NewTask (..) + , Task (..) + ) +import Web.Todoist.Domain.Types + ( Content (..) + , Description (..) + , Order (..) + , ParentId (..) + , ProjectId (..) + , TaskId (..) + , Uid (..) + ) +import Web.Todoist.Internal.Types + ( DeadlineResponse (..) + , DueResponse (..) + , DurationResponse (..) + , NewTaskResponse (..) + , TaskResponse (..) + , TodoistReturn (..) + ) +import qualified Web.Todoist.Internal.Types as IT +import Web.Todoist.Runner.IO.Interpreters () +import Web.Todoist.TestHelpers + ( sampleDeadline + , sampleDeadlineResponse + , sampleDue + , sampleDueResponse + , sampleDuration + , sampleDurationResponse + , sampleNewTask + , sampleNewTaskResponse + , sampleNewTaskResponseJson + , sampleTask + , sampleTaskResponse + , sampleTaskResponseJson + , sampleTasksJson + ) + +import Data.Aeson (decode, eitherDecode, encode) +import Data.Bool (Bool (..)) +import Data.Either (Either (..), isRight) +import Data.Function (($)) +import Data.Int (Int) +import Data.List (head, length) +import Data.Maybe (Maybe (..), fromJust, isJust) +import Data.String (String) +import Data.Text (Text) +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) + +spec :: Spec +spec = do + describe "TodoistTaskM TodoistIO implementations" $ do + parseDurationUnitSpec + durationConversionSpec + deadlineConversionSpec + dueConversionSpec + taskResponseParsingSpec + taskConversionSpec + newTaskResponseParsingSpec + newTaskConversionSpec + todoistReturnTasksSpec + +parseDurationUnitSpec :: Spec +parseDurationUnitSpec = describe "parseDurationUnit" $ do + it "parses 'minute' correctly" $ do + let durationResp = IT.DurationResponse {IT.p_amount = 30, IT.p_unit = "minute"} + let decoded = decode (encode durationResp) :: Maybe DurationResponse + decoded `shouldSatisfy` isJust + + it "parses 'day' correctly" $ do + let durationResp = IT.DurationResponse {IT.p_amount = 5, IT.p_unit = "day"} + let decoded = decode (encode durationResp) :: Maybe DurationResponse + decoded `shouldSatisfy` isJust + + it "handles case variations" $ do + let durationResp1 = IT.DurationResponse {IT.p_amount = 30, IT.p_unit = "MINUTE"} + let durationResp2 = IT.DurationResponse {IT.p_amount = 5, IT.p_unit = "Day"} + decode (encode durationResp1) `shouldSatisfy` (isJust :: Maybe DurationResponse -> Bool) + decode (encode durationResp2) `shouldSatisfy` (isJust :: Maybe DurationResponse -> Bool) + +durationConversionSpec :: Spec +durationConversionSpec = describe "DurationResponse JSON parsing" $ do + it "parses valid DurationResponse JSON" $ do + let json = "{\"amount\":30,\"unit\":\"minute\"}" + let result = eitherDecode json :: Either String DurationResponse + result `shouldSatisfy` isRight + + it "correctly parses all fields from JSON" $ do + let json = "{\"amount\":30,\"unit\":\"minute\"}" + let decoded = decode json :: Maybe DurationResponse + decoded `shouldSatisfy` isJust + let response :: DurationResponse = fromJust decoded + response.p_amount `shouldBe` (30 :: Int) + response.p_unit `shouldBe` ("minute" :: Text) + + it "matches sample data" $ do + let encoded = encode sampleDurationResponse + let decoded = decode encoded :: Maybe DurationResponse + decoded `shouldSatisfy` isJust + fromJust decoded `shouldBe` sampleDurationResponse + +deadlineConversionSpec :: Spec +deadlineConversionSpec = describe "DeadlineResponse JSON parsing" $ do + it "parses valid DeadlineResponse JSON" $ do + let json = "{\"date\":\"2025-12-31\",\"lang\":\"en\"}" + let result = eitherDecode json :: Either String DeadlineResponse + result `shouldSatisfy` isRight + + it "correctly parses all fields from JSON" $ do + let json = "{\"date\":\"2025-12-31\",\"lang\":\"en\"}" + let decoded = decode json :: Maybe DeadlineResponse + decoded `shouldSatisfy` isJust + let response :: DeadlineResponse = fromJust decoded + response.p_date `shouldBe` ("2025-12-31" :: Text) + response.p_lang `shouldBe` ("en" :: Text) + + it "matches sample data" $ do + let encoded = encode sampleDeadlineResponse + let decoded = decode encoded :: Maybe DeadlineResponse + decoded `shouldSatisfy` isJust + fromJust decoded `shouldBe` sampleDeadlineResponse + +dueConversionSpec :: Spec +dueConversionSpec = describe "DueResponse JSON parsing" $ do + it "parses valid DueResponse JSON" $ do + let json = + "{\"date\":\"2025-11-15\",\"string\":\"Nov 15\",\"lang\":\"en\",\"is_recurring\":false,\"timezone\":\"America/New_York\"}" + let result = eitherDecode json :: Either String DueResponse + result `shouldSatisfy` isRight + + it "correctly parses all fields from JSON" $ do + let json = + "{\"date\":\"2025-11-15\",\"string\":\"Nov 15\",\"lang\":\"en\",\"is_recurring\":false,\"timezone\":\"America/New_York\"}" + let decoded = decode json :: Maybe DueResponse + decoded `shouldSatisfy` isJust + let response :: DueResponse = fromJust decoded + response.p_date `shouldBe` ("2025-11-15" :: Text) + response.p_string `shouldBe` ("Nov 15" :: Text) + response.p_lang `shouldBe` ("en" :: Text) + response.p_is_recurring `shouldBe` False + response.p_timezone `shouldBe` Just ("America/New_York" :: Text) + + it "handles optional timezone field" $ do + let json = + "{\"date\":\"2025-11-15\",\"string\":\"Nov 15\",\"lang\":\"en\",\"is_recurring\":false,\"timezone\":null}" + let decoded = decode json :: Maybe DueResponse + decoded `shouldSatisfy` isJust + let response :: DueResponse = fromJust decoded + response.p_timezone `shouldBe` (Nothing :: Maybe Text) + + it "matches sample data" $ do + let encoded = encode sampleDueResponse + let decoded = decode encoded :: Maybe DueResponse + decoded `shouldSatisfy` isJust + fromJust decoded `shouldBe` sampleDueResponse + +taskResponseParsingSpec :: Spec +taskResponseParsingSpec = describe "TaskResponse" $ do + describe "JSON parsing" $ do + it "parses valid TaskResponse JSON" $ do + let result = eitherDecode sampleTaskResponseJson :: Either String TaskResponse + result `shouldSatisfy` isRight + + it "correctly parses all fields from JSON" $ do + let decoded = decode sampleTaskResponseJson :: Maybe TaskResponse + decoded `shouldSatisfy` isJust + let response :: TaskResponse = fromJust decoded + response.p_user_id `shouldBe` ("56092663" :: Text) + response.p_id `shouldBe` ("7654321098" :: Text) + response.p_project_id `shouldBe` ("2203306141" :: Text) + response.p_section_id `shouldBe` Just ("section123" :: Text) + response.p_parent_id `shouldBe` Just ("parent456" :: Text) + response.p_labels `shouldBe` (["urgent", "work"] :: [Text]) + response.p_priority `shouldBe` (3 :: Int) + response.p_content `shouldBe` ("Test Task Content" :: Text) + response.p_description `shouldBe` ("This is a test task description" :: Text) + + it "handles nested optional fields (due, deadline, duration)" $ do + let decoded = decode sampleTaskResponseJson :: Maybe TaskResponse + decoded `shouldSatisfy` isJust + let response :: TaskResponse = fromJust decoded + response.p_due `shouldSatisfy` isJust + response.p_deadline `shouldSatisfy` isJust + response.p_duration `shouldSatisfy` isJust + + it "matches sample data" $ do + let encoded = encode sampleTaskResponse + let decoded = decode encoded :: Maybe TaskResponse + decoded `shouldSatisfy` isJust + fromJust decoded `shouldBe` sampleTaskResponse + +taskConversionSpec :: Spec +taskConversionSpec = describe "taskResponseToTask conversion" $ do + it "verifies sample Task domain model structure" $ do + -- We can't directly test the conversion function since it's not exported + -- But we can verify our sample data is correctly structured + let task :: Task = sampleTask + task._id `shouldBe` TaskId "7654321098" + task._content `shouldBe` Content "Test Task Content" + task._description `shouldBe` Description "This is a test task description" + task._project_id `shouldBe` ProjectId "2203306141" + task._section_id `shouldBe` Just (SectionId "section123") + task._parent_id `shouldBe` Just (ParentId "parent456") + task._labels `shouldBe` (["urgent", "work"] :: [Text]) + task._priority `shouldBe` (3 :: Int) + task._order `shouldBe` Order 1 + task._creator_id `shouldBe` Uid "56092663" + task._created_at `shouldBe` ("2025-11-01T10:00:00Z" :: Text) + task._updated_at `shouldBe` ("2025-11-03T14:30:00Z" :: Text) + + it "verifies nested optional fields in domain model" $ do + let task :: Task = sampleTask + task._due `shouldSatisfy` isJust + task._deadline `shouldSatisfy` isJust + task._duration `shouldSatisfy` isJust + task._assignee_id `shouldBe` Just (Uid "assignee789") + task._assigner_id `shouldBe` Just (Uid "56092663") + + it "verifies Due conversion" $ do + let due :: Due = sampleDue + due._date `shouldBe` ("2025-11-15" :: Text) + due._string `shouldBe` ("Nov 15" :: Text) + due._lang `shouldBe` ("en" :: Text) + due._is_recurring `shouldBe` False + due._timezone `shouldBe` Just ("America/New_York" :: Text) + + it "verifies Deadline conversion" $ do + let deadline :: Deadline = sampleDeadline + deadline._date `shouldBe` ("2025-12-31" :: Text) + deadline._lang `shouldBe` ("en" :: Text) + + it "verifies Duration conversion" $ do + let Duration {_amount, _unit} = sampleDuration + _amount `shouldBe` (30 :: Int) + _unit `shouldBe` Minute + +newTaskResponseParsingSpec :: Spec +newTaskResponseParsingSpec = describe "NewTaskResponse" $ do + describe "JSON parsing" $ do + it "parses valid NewTaskResponse JSON" $ do + let result = eitherDecode sampleNewTaskResponseJson :: Either String NewTaskResponse + result `shouldSatisfy` isRight + + it "correctly parses all fields from JSON" $ do + let decoded = decode sampleNewTaskResponseJson :: Maybe NewTaskResponse + decoded `shouldSatisfy` isJust + let response :: NewTaskResponse = fromJust decoded + response.p_user_id `shouldBe` ("56092663" :: Text) + response.p_id `shouldBe` ("9876543210" :: Text) + response.p_project_id `shouldBe` ("2203306141" :: Text) + response.p_section_id `shouldBe` (Nothing :: Maybe Text) + response.p_parent_id `shouldBe` (Nothing :: Maybe Text) + response.p_labels `shouldBe` (["new"] :: [Text]) + response.p_priority `shouldBe` (1 :: Int) + response.p_content `shouldBe` ("New Task" :: Text) + response.p_description `shouldBe` ("A newly created task" :: Text) + response.p_checked `shouldBe` False + response.p_is_deleted `shouldBe` False + + it "matches sample data structure" $ do + let encoded = encode sampleNewTaskResponse + let decoded = decode encoded :: Maybe NewTaskResponse + decoded `shouldSatisfy` isJust + let response :: NewTaskResponse = fromJust decoded + response.p_id `shouldBe` ("9876543210" :: Text) + response.p_content `shouldBe` ("New Task" :: Text) + response.p_priority `shouldBe` (1 :: Int) + +newTaskConversionSpec :: Spec +newTaskConversionSpec = describe "newTaskResponseToNewTask conversion" $ do + it "verifies sample NewTask domain model structure" $ do + let newTask :: NewTask = sampleNewTask + newTask._user_id `shouldBe` ("56092663" :: Text) + newTask._id `shouldBe` TaskId "9876543210" + newTask._project_id `shouldBe` ProjectId "2203306141" + newTask._section_id `shouldBe` (Nothing :: Maybe SectionId) + newTask._parent_id `shouldBe` (Nothing :: Maybe ParentId) + newTask._labels `shouldBe` (["new"] :: [Text]) + newTask._priority `shouldBe` (1 :: Int) + newTask._content `shouldBe` Content "New Task" + newTask._description `shouldBe` Description "A newly created task" + newTask._checked `shouldBe` False + newTask._is_deleted `shouldBe` False + newTask._child_order `shouldBe` Order 0 + + it "handles optional fields correctly" $ do + let newTask :: NewTask = sampleNewTask + newTask._added_at `shouldBe` Just ("2025-11-04T09:00:00Z" :: Text) + newTask._completed_at `shouldBe` (Nothing :: Maybe Text) + newTask._updated_at `shouldBe` Just ("2025-11-04T09:00:00Z" :: Text) + +todoistReturnTasksSpec :: Spec +todoistReturnTasksSpec = describe "TodoistReturn [TaskResponse]" $ do + it "parses getTasks response JSON" $ do + let result = eitherDecode sampleTasksJson :: Either String (TodoistReturn TaskResponse) + result `shouldSatisfy` isRight + + it "extracts results from TodoistReturn" $ do + let decoded = decode sampleTasksJson :: Maybe (TodoistReturn TaskResponse) + decoded `shouldSatisfy` isJust + let TodoistReturn {results} = fromJust decoded + length results `shouldBe` (1 :: Int) + + it "correctly parses TaskResponse within TodoistReturn" $ do + let decoded = decode sampleTasksJson :: Maybe (TodoistReturn TaskResponse) + decoded `shouldSatisfy` isJust + let TodoistReturn {results} = fromJust decoded + let taskResp :: TaskResponse = head results + taskResp.p_id `shouldBe` ("7654321098" :: Text) + taskResp.p_content `shouldBe` ("Test Task Content" :: Text) + taskResp.p_priority `shouldBe` (3 :: Int) diff --git a/test/Web/Todoist/Runner/TodoistIOSpec.hs b/test/Web/Todoist/Runner/TodoistIOSpec.hs new file mode 100644 --- /dev/null +++ b/test/Web/Todoist/Runner/TodoistIOSpec.hs @@ -0,0 +1,346 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +module Web.Todoist.Runner.TodoistIOSpec (spec) where + +import Web.Todoist.Domain.Project + ( Collaborator + , Project + , ProjectCreate + , ProjectUpdate + , createdAt + , updatedAt + , viewStyle + , projectUpdateName + , projectUpdateDescription + , projectUpdateColor + , projectUpdateIsFavorite + , projectUpdateViewStyle + ) +import Web.Todoist.Domain.Types + ( Description (..) + , IsFavorite (..) + , Name (..) + , ProjectId (..) + , ViewStyle (..) + , parseViewStyle + ) +import Web.Todoist.Internal.Types + ( Action (..) + , CollaboratorRole (..) + , ProjectPermissions (..) + , ProjectResponse (..) + , RoleActions (..) + , TodoistReturn (..) + ) +import Web.Todoist.Runner.IO.Interpreters (projectResponseToProject) +import Web.Todoist.TestHelpers + ( sampleCollaborator + , sampleCollaboratorsJson + , samplePartialProjectUpdateJson + , sampleProject + , sampleProjectCreate + , sampleProjectId + , sampleProjectIdJson + , sampleProjectPermissionsJson + , sampleProjectResponse + , sampleProjectResponseJson + , sampleProjectUpdate + , sampleProjectUpdateJson + , sampleProjectsJson + ) +import Web.Todoist.Lens ((^.)) + +import Data.Aeson (decode, eitherDecode, encode) +import Data.Bool (Bool (..)) +import Data.Either (Either (..), isRight) +import Data.Function (($)) +import Data.Functor ((<$>)) +import Data.List (head, length, (!!)) +import Data.Maybe (Maybe (..), fromJust, isJust) +import Data.String (String) +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) + +spec :: Spec +spec = do + describe "TodoistProjectM TodoistIO implementations" $ do + getProjectSpec + getAllProjectsSpec + getProjectCollaboratorsSpec + addProjectSpec + deleteProjectSpec + archiveUnarchiveProjectSpec + getProjectPermissionsSpec + updateProjectSpec + +getProjectSpec :: Spec +getProjectSpec = describe "getProject" $ do + jsonParsingSpec + conversionSpec + viewStyleSpec + +jsonParsingSpec :: Spec +jsonParsingSpec = describe "ProjectResponse JSON parsing" $ do + it "parses valid ProjectResponse JSON" $ do + let result = eitherDecode sampleProjectResponseJson :: Either String ProjectResponse + result `shouldSatisfy` isRight + + it "correctly parses all fields from JSON" $ do + let decoded = decode sampleProjectResponseJson :: Maybe ProjectResponse + decoded `shouldSatisfy` isJust + + let ProjectResponse + { p_id = projId + , p_name = projName + , p_description = projDescription + , p_child_order = projChildOrder + , p_color = projColor + , p_is_favorite = projIsFavorite + , p_is_archived = projIsArchived + , p_is_collapsed = projIsCollapsed + , p_is_shared = projIsShared + , p_can_assign_tasks = projCanAssignTasks + , p_view_style = projViewStyle + } = fromJust decoded + projId `shouldBe` "2203306141" + projName `shouldBe` "Test Project" + projDescription `shouldBe` "A test project for unit testing" + projChildOrder `shouldBe` 1 + projColor `shouldBe` "blue" + projIsFavorite `shouldBe` True + projIsArchived `shouldBe` False + projIsCollapsed `shouldBe` False + projIsShared `shouldBe` False + projCanAssignTasks `shouldBe` False + projViewStyle `shouldBe` "list" + +conversionSpec :: Spec +conversionSpec = describe "projectResponseToProject" $ do + it "converts ProjectResponse to Project correctly" $ do + let project = projectResponseToProject sampleProjectResponse + project `shouldBe` sampleProject + + it "maps all fields correctly" $ do + let project :: Project + project = projectResponseToProject sampleProjectResponse + project `shouldBe` sampleProject + + it "converts view_style string to ViewStyle type" $ do + let projectViewStyle = projectResponseToProject sampleProjectResponse ^. viewStyle + projectViewStyle `shouldBe` List + + it "preserves timestamp fields" $ do + let projectResponse = projectResponseToProject sampleProjectResponse + projectCreateAt = projectResponse ^. createdAt + projectUpdatedAt = projectResponse ^. updatedAt + projectCreateAt `shouldBe` Just "2023-06-15T10:30:00Z" + projectUpdatedAt `shouldBe` Just "2023-06-20T14:45:00Z" + +viewStyleSpec :: Spec +viewStyleSpec = describe "parseViewStyle" $ do + it "parses 'list' correctly" $ do + parseViewStyle "list" `shouldBe` List + + it "parses 'board' correctly" $ do + parseViewStyle "board" `shouldBe` Board + + it "parses 'calendar' correctly" $ do + parseViewStyle "calendar" `shouldBe` Calendar + + it "is case-insensitive" $ do + parseViewStyle "LIST" `shouldBe` List + parseViewStyle "Board" `shouldBe` Board + parseViewStyle "CALENDAR" `shouldBe` Calendar + +getAllProjectsSpec :: Spec +getAllProjectsSpec = describe "getAllProjects" $ do + it "parses TodoistReturn [ProjectResponse] JSON" $ do + let result = eitherDecode sampleProjectsJson :: Either String (TodoistReturn ProjectResponse) + result `shouldSatisfy` isRight + + it "extracts results from TodoistReturn" $ do + let decoded = decode sampleProjectsJson :: Maybe (TodoistReturn ProjectResponse) + decoded `shouldSatisfy` isJust + let todoistReturn = fromJust decoded + length (results todoistReturn) `shouldBe` 2 + + it "converts all ProjectResponses to Projects" $ do + let decoded = decode sampleProjectsJson :: Maybe (TodoistReturn ProjectResponse) + decoded `shouldSatisfy` isJust + let todoistReturn = fromJust decoded + let projects = projectResponseToProject <$> results todoistReturn + length projects `shouldBe` 2 + head projects `shouldBe` sampleProject + + it "correctly parses multiple projects" $ do + let decoded = decode sampleProjectsJson :: Maybe (TodoistReturn ProjectResponse) + let todoistReturn = fromJust decoded + let projects :: [Project] + projects = projectResponseToProject <$> results todoistReturn + length projects `shouldBe` 2 + head projects `shouldBe` sampleProject + +getProjectCollaboratorsSpec :: Spec +getProjectCollaboratorsSpec = describe "getProjectCollaborators" $ do + it "parses TodoistReturn [Collaborator] JSON" $ do + let result = eitherDecode sampleCollaboratorsJson :: Either String (TodoistReturn Collaborator) + result `shouldSatisfy` isRight + + it "extracts collaborators from TodoistReturn" $ do + let decoded = decode sampleCollaboratorsJson :: Maybe (TodoistReturn Collaborator) + decoded `shouldSatisfy` isJust + let todoistReturn = fromJust decoded + length (results todoistReturn) `shouldBe` 2 + + it "correctly parses Collaborator fields" $ do + let decoded = decode sampleCollaboratorsJson :: Maybe (TodoistReturn Collaborator) + let todoistReturn = fromJust decoded + let collaborators = results todoistReturn + head collaborators `shouldBe` sampleCollaborator + + it "parses multiple collaborators correctly" $ do + let decoded = decode sampleCollaboratorsJson :: Maybe (TodoistReturn Collaborator) + let todoistReturn = fromJust decoded + let collaborators :: [Collaborator] + collaborators = results todoistReturn + length collaborators `shouldBe` 2 + head collaborators `shouldBe` sampleCollaborator + +addProjectSpec :: Spec +addProjectSpec = describe "addProject" $ do + it "serializes ProjectCreate to JSON correctly" $ do + let encoded = encode sampleProjectCreate + let decoded = decode encoded :: Maybe ProjectCreate + decoded `shouldSatisfy` isJust + + it "parses ProjectId response JSON" $ do + let result = eitherDecode sampleProjectIdJson :: Either String ProjectId + result `shouldSatisfy` isRight + + it "correctly parses ProjectId fields" $ do + let decoded = decode sampleProjectIdJson :: Maybe ProjectId + decoded `shouldSatisfy` isJust + let projectId :: ProjectId + projectId = fromJust decoded + projectId `shouldBe` sampleProjectId + +deleteProjectSpec :: Spec +deleteProjectSpec = describe "deleteProject" $ do + it "returns unit type (no response body to parse)" $ do + -- deleteProject returns (), which indicates successful deletion + -- There's no JSON response body to test, but we can verify the type + let result :: () + result = () + result `shouldBe` () + + it "is a void operation (no data returned)" $ do + -- The Todoist API DELETE endpoint returns no content (204 No Content) + -- The function signature is: deleteProject :: ProjectId -> TodoistIO () + -- This test documents that behavior + let unitValue :: () + unitValue = () + unitValue `shouldBe` () + +archiveUnarchiveProjectSpec :: Spec +archiveUnarchiveProjectSpec = describe "archiveProject and unarchiveProject" $ do + it "both return ProjectId on success (parses same JSON format)" $ do + let result = eitherDecode sampleProjectIdJson :: Either String ProjectId + result `shouldSatisfy` isRight + let projectId :: ProjectId + projectId = fromJust (decode sampleProjectIdJson :: Maybe ProjectId) + projectId `shouldBe` sampleProjectId + + it "ProjectId response is consistent across operations" $ do + let decoded = decode sampleProjectIdJson :: Maybe ProjectId + decoded `shouldSatisfy` isJust + decoded `shouldBe` Just sampleProjectId + +getProjectPermissionsSpec :: Spec +getProjectPermissionsSpec = describe "getProjectPermissions" $ do + jsonParsingPermissionsSpec + +jsonParsingPermissionsSpec :: Spec +jsonParsingPermissionsSpec = describe "ProjectPermissions JSON parsing" $ do + it "parses valid ProjectPermissions JSON" $ do + let result = eitherDecode sampleProjectPermissionsJson :: Either String ProjectPermissions + result `shouldSatisfy` isRight + + it "correctly parses all fields from JSON" $ do + let decoded = decode sampleProjectPermissionsJson :: Maybe ProjectPermissions + decoded `shouldSatisfy` isJust + let perms = fromJust decoded + length (p_project_collaborator_actions perms) `shouldBe` 1 + length (p_workspace_collaborator_actions perms) `shouldBe` 1 + + it "correctly parses role as Creator" $ do + let decoded = decode sampleProjectPermissionsJson :: Maybe ProjectPermissions + decoded `shouldSatisfy` isJust + let perms = fromJust decoded + let RoleActions {p_name = roleName} = head (p_project_collaborator_actions perms) + roleName `shouldBe` Creator + + it "correctly parses action names as Text" $ do + let decoded = decode sampleProjectPermissionsJson :: Maybe ProjectPermissions + decoded `shouldSatisfy` isJust + let perms = fromJust decoded + let RoleActions {p_actions = actions} = head (p_project_collaborator_actions perms) + length actions `shouldBe` 2 + let Action {p_name = action1Name} = head actions + let Action {p_name = action2Name} = actions !! 1 + action1Name `shouldBe` "create_task" + action2Name `shouldBe` "delete_project" + +updateProjectSpec :: Spec +updateProjectSpec = describe "updateProject" $ do + jsonSerializationSpec + jsonParsingUpdateSpec + jsonPartialUpdateSpec + +jsonSerializationSpec :: Spec +jsonSerializationSpec = describe "ProjectUpdate JSON serialization" $ do + it "serializes ProjectUpdate to valid JSON" $ do + let json = encode sampleProjectUpdate + let result = eitherDecode json :: Either String ProjectUpdate + result `shouldSatisfy` isRight + + it "serializes all fields correctly" $ do + let json = encode sampleProjectUpdate + let decoded = decode json :: Maybe ProjectUpdate + decoded `shouldBe` Just sampleProjectUpdate + +jsonParsingUpdateSpec :: Spec +jsonParsingUpdateSpec = describe "ProjectUpdate JSON parsing" $ do + it "parses valid ProjectUpdate JSON" $ do + let result = eitherDecode sampleProjectUpdateJson :: Either String ProjectUpdate + result `shouldSatisfy` isRight + + it "correctly parses all fields from JSON" $ do + let decoded = decode sampleProjectUpdateJson :: Maybe ProjectUpdate + decoded `shouldSatisfy` isJust + let projectUpdate = fromJust decoded + name = projectUpdate ^. projectUpdateName + desc = projectUpdate ^. projectUpdateDescription + isFav = projectUpdate ^. projectUpdateIsFavorite + name `shouldBe` Just (Name "Updated Project Name") + desc `shouldBe` Just (Description "Updated description") + isFav `shouldBe` Just (IsFavorite True) + +jsonPartialUpdateSpec :: Spec +jsonPartialUpdateSpec = describe "Partial ProjectUpdate" $ do + it "parses partial update JSON correctly" $ do + let result = eitherDecode samplePartialProjectUpdateJson :: Either String ProjectUpdate + result `shouldSatisfy` isRight + + it "handles missing fields as Nothing" $ do + let decoded = decode samplePartialProjectUpdateJson :: Maybe ProjectUpdate + decoded `shouldSatisfy` isJust + let projectUpdate = fromJust decoded + name = projectUpdate ^. projectUpdateName + desc = projectUpdate ^. projectUpdateDescription + color = projectUpdate ^. projectUpdateColor + isFav = projectUpdate ^. projectUpdateIsFavorite + viewStyle = projectUpdate ^. projectUpdateViewStyle + name `shouldBe` Just (Name "New Name") + desc `shouldBe` Nothing + color `shouldBe` Nothing + isFav `shouldBe` Just (IsFavorite True) + viewStyle `shouldBe` Nothing diff --git a/test/Web/Todoist/TestHelpers.hs b/test/Web/Todoist/TestHelpers.hs new file mode 100644 --- /dev/null +++ b/test/Web/Todoist/TestHelpers.hs @@ -0,0 +1,832 @@ +{-# LANGUAGE DisambiguateRecordFields #-} + +module Web.Todoist.TestHelpers + ( -- Project-related exports + sampleProjectResponse + , sampleProjectResponseJson + , sampleProjectId + , sampleProjectIdJson + , sampleProject + , sampleProjects + , sampleProjectsJson + , sampleCollaborator + , sampleCollaborators + , sampleCollaboratorsJson + , sampleProjectCreate + , sampleProjectCreateJson + , sampleProjectUpdate + , sampleProjectUpdateJson + , samplePartialProjectUpdate + , samplePartialProjectUpdateJson + , sampleAction + , sampleRoleActions + , sampleProjectPermissions + , sampleProjectPermissionsJson + -- Task-related exports + , sampleDurationResponse + , sampleDuration + , sampleDeadlineResponse + , sampleDeadline + , sampleDueResponse + , sampleDue + , sampleTaskResponse + , sampleTaskResponseJson + , sampleTask + , sampleTaskId + , sampleNewTaskResponse + , sampleNewTaskResponseJson + , sampleNewTask + , sampleTasksJson + -- Comment-related exports + , sampleCommentId + , sampleCommentResponse + , sampleCommentResponseJson + , sampleComment + , sampleCommentResponseWithAttachment + , sampleCommentResponseWithAttachmentJson + , sampleCommentCreate + -- Section-related exports + , sampleSectionId + , sampleSectionResponse + , sampleSectionResponseJson + , sampleSection + , sampleSectionCreate + , sampleSectionUpdate + , sampleSectionsJson + -- Label-related exports + , sampleLabelResponse + , sampleLabel + , sampleLabelResponseJson + , sampleLabelsJson + , sampleSharedLabelsJson + ) where + +import Web.Todoist.Domain.Comment + ( Comment (..) + , CommentCreate + , CommentId (..) + , Content (..) + , newCommentBuilder + ) +import Web.Todoist.Domain.Label + ( Label (..) + , LabelId (..) + ) +import Web.Todoist.Domain.Project + ( CanAssignTasks (..) + , Collaborator (..) + , IsArchived (..) + , IsShared (..) + , Project (..) + , ProjectCreate + , ProjectUpdate + , createProjectBuilder + , updateProjectBuilder + ) +import Web.Todoist.Domain.Section + ( Section (..) + , SectionCreate + , SectionId (..) + , SectionUpdate + , newSectionBuilder + , updateSectionBuilder + ) +import Web.Todoist.Domain.Task + ( Deadline (..) + , Due (..) + , Duration (..) + , DurationUnit (..) + , NewTask (..) + , Task (..) + ) +import Web.Todoist.Domain.Types + ( Color (..) + , Description (..) + , IsCollapsed (..) + , IsFavorite (..) + , Name (..) + , Order (..) + , ParentId (..) + , ProjectId (..) + , TaskId (..) + , Uid (..) + , ViewStyle (..) + ) +import Web.Todoist.Internal.Types + ( Action (..) + , CollaboratorRole (..) + , CommentResponse (..) + , CreatedAt (..) + , CreatorUid (..) + , DeadlineResponse (..) + , DueResponse (..) + , DurationResponse (..) + , FileAttachment (..) + , LabelResponse (..) + , NewTaskResponse (..) + , ProjectPermissions (..) + , ProjectResponse (..) + , Role (..) + , RoleActions (..) + , SectionResponse (..) + , TaskResponse (..) + , UpdatedAt (..) + ) +import qualified Web.Todoist.Internal.Types as Internal +import Web.Todoist.Util.Builder (runBuilder, withColor, withDescription, withName, withIsFavorite, withViewStyle) + +import Data.Bool (Bool (..)) +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy.Char8 as BSL +import Data.Function (($)) +import Data.Maybe (Maybe (..)) +import Data.Monoid (mempty, (<>)) + +-- | Sample ProjectId for testing +sampleProjectId :: ProjectId +sampleProjectId = ProjectId {getProjectId = "2203306141"} + +-- | Sample ProjectResponse with all fields populated +sampleProjectResponse :: ProjectResponse +sampleProjectResponse = + ProjectResponse + { p_id = "2203306141" + , p_can_assign_tasks = False + , p_child_order = 1 + , p_color = "blue" + , p_creator_uid = CreatorUid (Just "12345678") + , p_created_at = CreatedAt (Just "2023-06-15T10:30:00Z") + , p_is_archived = False + , p_is_deleted = False + , p_is_favorite = True + , p_is_frozen = False + , p_name = "Test Project" + , p_updated_at = UpdatedAt (Just "2023-06-20T14:45:00Z") + , p_view_style = "list" + , p_default_order = 0 + , p_description = "A test project for unit testing" + , p_public_key = "test-public-key" + , p_access = Nothing + , p_role = Role Nothing + , p_parent_id = Internal.ParentId {p_parent_id = Nothing} + , p_inbox_project = False + , p_is_collapsed = False + , p_is_shared = False + } + +-- | Sample Project (domain model) corresponding to sampleProjectResponse +sampleProject :: Project +sampleProject = + Project + { _id = ProjectId "2203306141" + , _name = Name "Test Project" + , _description = Description "A test project for unit testing" + , _order = Order 1 + , _color = Color "blue" + , _is_collapsed = IsCollapsed False + , _is_shared = IsShared False + , _is_favorite = IsFavorite True + , _is_archived = IsArchived False + , _can_assign_tasks = CanAssignTasks False + , _view_style = List + , _created_at = Just "2023-06-15T10:30:00Z" + , _updated_at = Just "2023-06-20T14:45:00Z" + } + +-- | JSON representation of a valid ProjectResponse +sampleProjectResponseJson :: ByteString +sampleProjectResponseJson = + BSL.pack + "{\ + \\"id\":\"2203306141\",\ + \\"can_assign_tasks\":false,\ + \\"child_order\":1,\ + \\"color\":\"blue\",\ + \\"creator_uid\":{\"creator_uid\":\"12345678\"},\ + \\"created_at\":{\"created_at\":\"2023-06-15T10:30:00Z\"},\ + \\"is_archived\":false,\ + \\"is_deleted\":false,\ + \\"is_favorite\":true,\ + \\"is_frozen\":false,\ + \\"name\":\"Test Project\",\ + \\"updated_at\":{\"updated_at\":\"2023-06-20T14:45:00Z\"},\ + \\"view_style\":\"list\",\ + \\"default_order\":0,\ + \\"description\":\"A test project for unit testing\",\ + \\"public_key\":\"test-public-key\",\ + \\"access\":null,\ + \\"role\":{\"role\":null},\ + \\"parent_id\":{\"parent_id\":null},\ + \\"inbox_project\":false,\ + \\"is_collapsed\":false,\ + \\"is_shared\":false\ + \}" + +-- | Sample ProjectId JSON response (fieldLabelModifier drops 1 char from _id -> id) +sampleProjectIdJson :: ByteString +sampleProjectIdJson = BSL.pack "{\"id\":\"2203306141\"}" + +-- | Sample list of projects for getAllProjects +sampleProjects :: [Project] +sampleProjects = [sampleProject, sampleProject {_id = ProjectId "2203306142", _name = Name "Second Project"}] + +-- | JSON for TodoistReturn [ProjectResponse] (getAllProjects response) +sampleProjectsJson :: ByteString +sampleProjectsJson = + BSL.pack + "{\ + \\"results\":[\ + \{\"id\":\"2203306141\",\"can_assign_tasks\":false,\"child_order\":1,\"color\":\"blue\",\ + \\"creator_uid\":{\"creator_uid\":\"12345678\"},\"created_at\":\"2023-06-15T10:30:00Z\",\ + \\"is_archived\":false,\"is_deleted\":false,\"is_favorite\":true,\"is_frozen\":false,\ + \\"name\":\"Test Project\",\"updated_at\":\"2023-06-20T14:45:00Z\",\ + \\"view_style\":\"list\",\"default_order\":0,\"description\":\"A test project for unit testing\",\ + \\"public_key\":\"test-public-key\",\"access\":null,\"role\":{\"role\":null},\ + \\"parent_id\":{\"parent_id\":null},\"inbox_project\":false,\"is_collapsed\":false,\"is_shared\":false},\ + \{\"id\":\"2203306142\",\"can_assign_tasks\":false,\"child_order\":2,\"color\":\"blue\",\ + \\"creator_uid\":{\"creator_uid\":\"12345678\"},\"created_at\":\"2023-06-15T10:30:00Z\",\ + \\"is_archived\":false,\"is_deleted\":false,\"is_favorite\":true,\"is_frozen\":false,\ + \\"name\":\"Second Project\",\"updated_at\":\"2023-06-20T14:45:00Z\",\ + \\"view_style\":\"list\",\"default_order\":0,\"description\":\"A test project for unit testing\",\ + \\"public_key\":\"test-public-key\",\"access\":null,\"role\":{\"role\":null},\ + \\"parent_id\":{\"parent_id\":null},\"inbox_project\":false,\"is_collapsed\":false,\"is_shared\":false}\ + \],\ + \\"next_cursor\":null\ + \}" + +-- | Sample Collaborator +sampleCollaborator :: Collaborator +sampleCollaborator = + Collaborator + { _id = "user123" + , _name = Name "John Doe" + , _email = "john@example.com" + } + +-- | Sample list of collaborators +sampleCollaborators :: [Collaborator] +sampleCollaborators = + [ sampleCollaborator + , sampleCollaborator {_id = "user456", _name = Name "Jane Smith", _email = "jane@example.com"} + ] + +-- | JSON for TodoistReturn [Collaborator] +sampleCollaboratorsJson :: ByteString +sampleCollaboratorsJson = + BSL.pack + "{\ + \\"results\":[\ + \{\"id\":\"user123\",\"name\":\"John Doe\",\"email\":\"john@example.com\"},\ + \{\"id\":\"user456\",\"name\":\"Jane Smith\",\"email\":\"jane@example.com\"}\ + \],\ + \\"next_cursor\":null\ + \}" + +-- | Sample ProjectCreate +sampleProjectCreate :: ProjectCreate +sampleProjectCreate = runBuilder (createProjectBuilder "New Project") (withDescription "A new project to be created") + +-- | JSON representation of ProjectCreate (for serialization test) +sampleProjectCreateJson :: ByteString +sampleProjectCreateJson = + BSL.pack + "{\ + \\"name\":\"New Project\",\ + \\"description\":\"A new project to be created\"\ + \}" + +-- | Sample ProjectUpdate for testing +sampleProjectUpdate :: ProjectUpdate +sampleProjectUpdate = runBuilder updateProjectBuilder (withName "Updated Project Name" <> withDescription "Updated description" <> withColor "red" <> withIsFavorite True <> withViewStyle List) + +-- | JSON representation of ProjectUpdate +sampleProjectUpdateJson :: ByteString +sampleProjectUpdateJson = + BSL.pack + "{\ + \\"name\":\"Updated Project Name\",\ + \\"description\":\"Updated description\",\ + \\"color\":\"red\",\ + \\"is_favorite\":true,\ + \\"view_style\":\"list\"\ + \}" + +-- | Sample ProjectUpdate with only some fields (partial update) +samplePartialProjectUpdate :: ProjectUpdate +samplePartialProjectUpdate = runBuilder updateProjectBuilder (withName "New Name" <> withIsFavorite True) + +-- | JSON representation of partial ProjectUpdate +samplePartialProjectUpdateJson :: ByteString +samplePartialProjectUpdateJson = + BSL.pack + "{\ + \\"name\":\"New Name\",\ + \\"is_favorite\":true\ + \}" + +-- | Sample Action for permissions testing +sampleAction :: Action +sampleAction = Action {p_name = "create_task"} + +-- | Sample RoleActions for permissions testing +sampleRoleActions :: RoleActions +sampleRoleActions = + RoleActions + { p_name = Creator + , p_actions = [sampleAction, Action {p_name = "delete_project"}] + } + +-- | Sample ProjectPermissions for testing +sampleProjectPermissions :: ProjectPermissions +sampleProjectPermissions = + ProjectPermissions + { p_project_collaborator_actions = [sampleRoleActions] + , p_workspace_collaborator_actions = [sampleRoleActions] + } + +-- | JSON representation of ProjectPermissions +sampleProjectPermissionsJson :: ByteString +sampleProjectPermissionsJson = + BSL.pack + "{\ + \\"project_collaborator_actions\":[{\ + \\"name\":\"CREATOR\",\ + \\"actions\":[{\"name\":\"create_task\"},{\"name\":\"delete_project\"}]\ + \}],\ + \\"workspace_collaborator_actions\":[{\ + \\"name\":\"CREATOR\",\ + \\"actions\":[{\"name\":\"create_task\"},{\"name\":\"delete_project\"}]\ + \}]\ + \}" + +-- ============================================================================ +-- Task-related test data +-- ============================================================================ + +-- | Sample DurationResponse for testing +sampleDurationResponse :: DurationResponse +sampleDurationResponse = + DurationResponse + { p_amount = 30 + , p_unit = "minute" + } + +-- | Sample Duration (domain model) +sampleDuration :: Duration +sampleDuration = + Duration + { _amount = 30 + , _unit = Minute + } + +-- | Sample DeadlineResponse for testing +sampleDeadlineResponse :: DeadlineResponse +sampleDeadlineResponse = + DeadlineResponse + { p_date = "2025-12-31" + , p_lang = "en" + } + +-- | Sample Deadline (domain model) +sampleDeadline :: Deadline +sampleDeadline = + Deadline + { _date = "2025-12-31" + , _lang = "en" + } + +-- | Sample DueResponse for testing +sampleDueResponse :: DueResponse +sampleDueResponse = + DueResponse + { p_date = "2025-11-15" + , p_string = "Nov 15" + , p_lang = "en" + , p_is_recurring = False + , p_timezone = Just "America/New_York" + } + +-- | Sample Due (domain model) +sampleDue :: Due +sampleDue = + Due + { _date = "2025-11-15" + , _string = "Nov 15" + , _lang = "en" + , _is_recurring = False + , _timezone = Just "America/New_York" + } + +-- | Sample TaskId for testing +sampleTaskId :: TaskId +sampleTaskId = TaskId {getTaskId = "7654321098"} + +-- | Sample TaskResponse with all fields populated +sampleTaskResponse :: TaskResponse +sampleTaskResponse = + TaskResponse + { p_user_id = "56092663" + , p_id = "7654321098" + , p_project_id = "2203306141" + , p_section_id = Just "section123" + , p_parent_id = Just "parent456" + , p_added_by_uid = Just "56092663" + , p_assigned_by_uid = Just "56092663" + , p_responsible_uid = Just "assignee789" + , p_labels = ["urgent", "work"] + , p_deadline = Just sampleDeadlineResponse + , p_duration = Just sampleDurationResponse + , p_checked = False + , p_is_deleted = False + , p_added_at = Just "2025-11-01T10:00:00Z" + , p_completed_at = Nothing + , p_updated_at = Just "2025-11-03T14:30:00Z" + , p_due = Just sampleDueResponse + , p_priority = 3 + , p_child_order = 1 + , p_content = "Test Task Content" + , p_description = "This is a test task description" + , p_note_count = 2 + , p_day_order = 5 + , p_is_collapsed = False + } + +-- | Sample Task (domain model) corresponding to sampleTaskResponse +sampleTask :: Task +sampleTask = + Task + { _id = TaskId "7654321098" + , _content = Content "Test Task Content" + , _description = Description "This is a test task description" + , _project_id = ProjectId "2203306141" + , _section_id = Just (SectionId {_id = "section123"}) + , _parent_id = Just (ParentId "parent456") + , _labels = ["urgent", "work"] + , _priority = 3 + , _due = Just sampleDue + , _deadline = Just sampleDeadline + , _duration = Just sampleDuration + , _is_collapsed = IsCollapsed False + , _order = Order 1 + , _assignee_id = Just (Uid "assignee789") + , _assigner_id = Just (Uid "56092663") + , _completed_at = Nothing + , _creator_id = Uid "56092663" + , _created_at = "2025-11-01T10:00:00Z" + , _updated_at = "2025-11-03T14:30:00Z" + } + +-- | JSON representation of a valid TaskResponse +sampleTaskResponseJson :: ByteString +sampleTaskResponseJson = + BSL.pack + "{\ + \\"user_id\":\"56092663\",\ + \\"id\":\"7654321098\",\ + \\"project_id\":\"2203306141\",\ + \\"section_id\":\"section123\",\ + \\"parent_id\":\"parent456\",\ + \\"added_by_uid\":\"56092663\",\ + \\"assigned_by_uid\":\"56092663\",\ + \\"responsible_uid\":\"assignee789\",\ + \\"labels\":[\"urgent\",\"work\"],\ + \\"deadline\":{\"date\":\"2025-12-31\",\"lang\":\"en\"},\ + \\"duration\":{\"amount\":30,\"unit\":\"minute\"},\ + \\"checked\":false,\ + \\"is_deleted\":false,\ + \\"added_at\":\"2025-11-01T10:00:00Z\",\ + \\"completed_at\":null,\ + \\"updated_at\":\"2025-11-03T14:30:00Z\",\ + \\"due\":{\"date\":\"2025-11-15\",\"string\":\"Nov 15\",\"lang\":\"en\",\"is_recurring\":false,\"timezone\":\"America/New_York\"},\ + \\"priority\":3,\ + \\"child_order\":1,\ + \\"content\":\"Test Task Content\",\ + \\"description\":\"This is a test task description\",\ + \\"note_count\":2,\ + \\"day_order\":5,\ + \\"is_collapsed\":false\ + \}" + +-- | Sample NewTaskResponse for testing +sampleNewTaskResponse :: NewTaskResponse +sampleNewTaskResponse = + NewTaskResponse + { p_user_id = "56092663" + , p_id = "9876543210" + , p_project_id = "2203306141" + , p_section_id = Nothing + , p_parent_id = Nothing + , p_added_by_uid = Just "56092663" + , p_assigned_by_uid = Nothing + , p_responsible_uid = Nothing + , p_labels = ["new"] + , p_checked = False + , p_is_deleted = False + , p_added_at = Just "2025-11-04T09:00:00Z" + , p_completed_at = Nothing + , p_updated_at = Just "2025-11-04T09:00:00Z" + , p_priority = 1 + , p_child_order = 0 + , p_content = "New Task" + , p_description = "A newly created task" + , p_note_count = 0 + , p_day_order = 1 + , p_is_collapsed = False + } + +-- | Sample NewTask (domain model) corresponding to sampleNewTaskResponse +sampleNewTask :: NewTask +sampleNewTask = + NewTask + { _user_id = "56092663" + , _id = TaskId "9876543210" + , _project_id = ProjectId "2203306141" + , _section_id = Nothing + , _parent_id = Nothing + , _added_by_uid = Just (Uid "56092663") + , _assigned_by_uid = Nothing + , _responsible_uid = Nothing + , _labels = ["new"] + , _checked = False + , _is_deleted = False + , _added_at = Just "2025-11-04T09:00:00Z" + , _completed_at = Nothing + , _updated_at = Just "2025-11-04T09:00:00Z" + , _priority = 1 + , _child_order = Order 0 + , _content = Content "New Task" + , _description = Description "A newly created task" + , _note_count = 0 + , _day_order = Order 1 + , _is_collapsed = IsCollapsed False + } + +-- | JSON representation of a valid NewTaskResponse +sampleNewTaskResponseJson :: ByteString +sampleNewTaskResponseJson = + BSL.pack + "{\ + \\"user_id\":\"56092663\",\ + \\"id\":\"9876543210\",\ + \\"project_id\":\"2203306141\",\ + \\"section_id\":null,\ + \\"parent_id\":null,\ + \\"added_by_uid\":\"56092663\",\ + \\"assigned_by_uid\":null,\ + \\"responsible_uid\":null,\ + \\"labels\":[\"new\"],\ + \\"checked\":false,\ + \\"is_deleted\":false,\ + \\"added_at\":\"2025-11-04T09:00:00Z\",\ + \\"completed_at\":null,\ + \\"updated_at\":\"2025-11-04T09:00:00Z\",\ + \\"priority\":1,\ + \\"child_order\":0,\ + \\"content\":\"New Task\",\ + \\"description\":\"A newly created task\",\ + \\"note_count\":0,\ + \\"day_order\":1,\ + \\"is_collapsed\":false\ + \}" + +-- | JSON for TodoistReturn [TaskResponse] (getTasks response) +sampleTasksJson :: ByteString +sampleTasksJson = + BSL.pack + "{\ + \\"results\":[\ + \{\"user_id\":\"56092663\",\"id\":\"7654321098\",\"project_id\":\"2203306141\",\ + \\"section_id\":\"section123\",\"parent_id\":\"parent456\",\"added_by_uid\":\"56092663\",\ + \\"assigned_by_uid\":\"56092663\",\"responsible_uid\":\"assignee789\",\"labels\":[\"urgent\",\"work\"],\ + \\"deadline\":{\"date\":\"2025-12-31\",\"lang\":\"en\"},\"duration\":{\"amount\":30,\"unit\":\"minute\"},\ + \\"checked\":false,\"is_deleted\":false,\"added_at\":\"2025-11-01T10:00:00Z\",\"completed_at\":null,\ + \\"updated_at\":\"2025-11-03T14:30:00Z\",\"due\":{\"date\":\"2025-11-15\",\"string\":\"Nov 15\",\"lang\":\"en\",\"is_recurring\":false,\"timezone\":\"America/New_York\"},\ + \\"priority\":3,\"child_order\":1,\"content\":\"Test Task Content\",\"description\":\"This is a test task description\",\ + \\"note_count\":2,\"day_order\":5,\"is_collapsed\":false}\ + \],\ + \\"next_cursor\":null\ + \}" + +-- ===== Comment Fixtures ===== + +-- | Sample Comment ID +sampleCommentId :: CommentId +sampleCommentId = CommentId {getCommentId = "3012345678"} + +-- | Sample CommentResponse +sampleCommentResponse :: CommentResponse +sampleCommentResponse = + CommentResponse + { p_id = "3012345678" + , p_content = "This is a test comment" + , p_posted_uid = Just "2671355" + , p_posted_at = Just "2023-10-15T14:30:00Z" + , p_item_id = Nothing + , p_project_id = Just "2203306141" + , p_file_attachment = Nothing + , p_uids_to_notify = Just ["2671355"] + , p_is_deleted = False + , p_reactions = Nothing + } + +-- | Sample CommentResponse JSON +sampleCommentResponseJson :: ByteString +sampleCommentResponseJson = + BSL.pack + "{\ + \\"id\":\"3012345678\",\ + \\"content\":\"This is a test comment\",\ + \\"posted_uid\":\"2671355\",\ + \\"posted_at\":\"2023-10-15T14:30:00Z\",\ + \\"item_id\":null,\ + \\"project_id\":\"2203306141\",\ + \\"file_attachment\":null,\ + \\"uids_to_notify\":[\"2671355\"],\ + \\"is_deleted\":false,\ + \\"reactions\":null\ + \}" + +-- | Sample Comment +sampleComment :: Comment +sampleComment = + Comment + { _id = CommentId "3012345678" + , _content = Content "This is a test comment" + , _poster_id = Just (Uid "2671355") + , _posted_at = Just (Uid "2023-10-15T14:30:00Z") + , _task_id = Nothing + , _project_id = Just (ProjectId "2203306141") + , _attachment = Nothing + } + +-- | Sample CommentResponse with attachment +sampleCommentResponseWithAttachment :: CommentResponse +sampleCommentResponseWithAttachment = + CommentResponse + { p_id = "3012345679" + , p_content = "Comment with attachment" + , p_posted_uid = Just "2671355" + , p_posted_at = Just "2023-10-15T15:00:00Z" + , p_item_id = Just "2995104339" + , p_project_id = Nothing + , p_file_attachment = + Just $ + FileAttachment + { p_file_name = "document.pdf" + , p_file_type = "application/pdf" + , p_file_url = "https://example.com/document.pdf" + , p_resource_type = "file" + } + , p_uids_to_notify = Nothing + , p_is_deleted = False + , p_reactions = Nothing + } + +-- | Sample CommentResponse with attachment JSON +sampleCommentResponseWithAttachmentJson :: ByteString +sampleCommentResponseWithAttachmentJson = + BSL.pack + "{\ + \\"id\":\"3012345679\",\ + \\"content\":\"Comment with attachment\",\ + \\"posted_uid\":\"2671355\",\ + \\"posted_at\":\"2023-10-15T15:00:00Z\",\ + \\"item_id\":\"2995104339\",\ + \\"project_id\":null,\ + \\"file_attachment\":{\ + \\"file_name\":\"document.pdf\",\ + \\"file_type\":\"application/pdf\",\ + \\"file_url\":\"https://example.com/document.pdf\",\ + \\"resource_type\":\"file\"\ + \},\ + \\"uids_to_notify\":null,\ + \\"is_deleted\":false,\ + \\"reactions\":null\ + \}" + +-- | Sample CommentCreate +sampleCommentCreate :: CommentCreate +sampleCommentCreate = + runBuilder + (newCommentBuilder "New comment") + mempty + +-- ===== Section Fixtures ===== + +-- | Sample Section ID +sampleSectionId :: SectionId +sampleSectionId = SectionId {_id = "section123"} + +-- | Sample SectionResponse +sampleSectionResponse :: SectionResponse +sampleSectionResponse = + SectionResponse + { p_id = "section123" + , p_user_id = "user456" + , p_project_id = "project789" + , p_added_at = "2024-01-01T12:00:00Z" + , p_updated_at = Just "2024-01-02T14:30:00Z" + , p_archived_at = Nothing + , p_name = "Test Section" + , p_section_order = 1 + , p_is_archived = False + , p_is_deleted = False + , p_is_collapsed = False + } + +-- | Sample SectionResponse JSON +sampleSectionResponseJson :: ByteString +sampleSectionResponseJson = + BSL.pack + "{\ + \\"id\":\"section123\",\ + \\"user_id\":\"user456\",\ + \\"project_id\":\"project789\",\ + \\"added_at\":\"2024-01-01T12:00:00Z\",\ + \\"updated_at\":\"2024-01-02T14:30:00Z\",\ + \\"archived_at\":null,\ + \\"name\":\"Test Section\",\ + \\"section_order\":1,\ + \\"is_archived\":false,\ + \\"is_deleted\":false,\ + \\"is_collapsed\":false\ + \}" + +-- | Sample Section (domain model) +sampleSection :: Section +sampleSection = + Section + { _id = SectionId {_id = "section123"} + , _name = Name "Test Section" + , _project_id = ProjectId "project789" + , _is_collapsed = IsCollapsed False + , _order = Order 1 + } + +-- | Sample SectionCreate +sampleSectionCreate :: SectionCreate +sampleSectionCreate = runBuilder (newSectionBuilder "New Section" "project789") mempty + +-- | Sample SectionUpdate +sampleSectionUpdate :: SectionUpdate +sampleSectionUpdate = runBuilder updateSectionBuilder (withName "Updated Section") + +-- | JSON for TodoistReturn [SectionResponse] (getSections response) +sampleSectionsJson :: ByteString +sampleSectionsJson = + BSL.pack + "{\ + \\"results\":[{\ + \\"id\":\"section123\",\ + \\"user_id\":\"user456\",\ + \\"project_id\":\"project789\",\ + \\"added_at\":\"2024-01-01T12:00:00Z\",\ + \\"updated_at\":\"2024-01-02T14:30:00Z\",\ + \\"archived_at\":null,\ + \\"name\":\"Test Section\",\ + \\"section_order\":1,\ + \\"is_archived\":false,\ + \\"is_deleted\":false,\ + \\"is_collapsed\":false\ + \}],\ + \\"next_cursor\":null\ + \}" + +-- ==================== Label-related Helpers ==================== + +-- | Sample LabelResponse for testing +sampleLabelResponse :: LabelResponse +sampleLabelResponse = + LabelResponse + { p_id = "label123" + , p_name = "Test Label" + , p_color = "charcoal" + , p_order = Just 1 + , p_is_favorite = False + } + +-- | Sample Label domain type for testing +sampleLabel :: Label +sampleLabel = + Label + { _id = LabelId "label123" + , _name = Name "Test Label" + , _color = Color "charcoal" + , _order = Just (Order 1) + , _is_favorite = IsFavorite False + } + +-- | JSON for single LabelResponse +sampleLabelResponseJson :: ByteString +sampleLabelResponseJson = + "{\"id\":\"label123\",\"name\":\"Test Label\",\"color\":\"charcoal\",\"order\":1,\"is_favorite\":false}" + +-- | JSON for paginated labels response +sampleLabelsJson :: ByteString +sampleLabelsJson = + "{\"results\":[{\"id\":\"label123\",\"name\":\"Test Label\",\"color\":\"charcoal\",\"order\":1,\"is_favorite\":false}],\"next_cursor\":null}" + +-- | JSON for shared labels response +sampleSharedLabelsJson :: ByteString +sampleSharedLabelsJson = + "{\"results\":[\"Label1\",\"Label2\",\"Label3\"],\"next_cursor\":null}" diff --git a/todoist-sdk.cabal b/todoist-sdk.cabal new file mode 100644 --- /dev/null +++ b/todoist-sdk.cabal @@ -0,0 +1,198 @@ +cabal-version: 2.2 + +name: todoist-sdk +version: 0.1.2.1 +synopsis: Unofficial Haskell SDK for the Todoist REST API +description: + TodoistSDK provides a type-safe, tagless-final interface to the Todoist REST API. It includes comprehensive coverage of Projects, Tasks, Comments, Sections, and Labels endpoints with both real HTTP and tracing interpreters for testing. The library uses mtl-style type classes for operation definitions and provides a clean builder pattern for request construction. + +license: MIT +license-file: LICENSE +author: Sam S. Almahri +maintainer: sam.salmahri@gmail.com +homepage: https://github.com/samahri/TodoistSDK +bug-reports: https://github.com/samahri/TodoistSDK/issues +copyright: 2025 Sam S. Almahri +category: Web +build-type: Simple +extra-doc-files: + README.md + CHANGELOG.md + +tested-with: ghc ==9.10.2 + +source-repository head + type: git + location: https://github.com/samahri/TodoistSDK + + +-- Internal library - not exposed to end users but available to tests +library todoist-sdk-internal + hs-source-dirs: src/internal + exposed-modules: + Web.Todoist.Internal.Config + Web.Todoist.Internal.Error + Web.Todoist.Internal.HTTP + Web.Todoist.Internal.Request + Web.Todoist.Internal.Types + Web.Todoist.Internal.Json + + default-language: Haskell2010 + default-extensions: + InstanceSigs + OverloadedStrings + NoImplicitPrelude + + build-depends: + , aeson >=2.2.3.0 && <2.3 + , base >=4.7 && <5 + , bytestring >=0.12.2.0 && <0.12.3 + , req >=3.13.4 && <3.14 + , text >=2.1.2 && <2.2 + , transformers >=0.6.1.1 && <0.6.2.0 + + ghc-options: + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints + +-- Public library - this is what end users depend on +library + hs-source-dirs: src + exposed-modules: + Web.Todoist + Web.Todoist.Domain.Project + Web.Todoist.Domain.Task + Web.Todoist.Domain.Comment + Web.Todoist.Domain.Section + Web.Todoist.Domain.Label + Web.Todoist.Domain.Types + Web.Todoist.Lens + Web.Todoist.Util.Builder + Web.Todoist.Util.QueryParam + Web.Todoist.Runner + Web.Todoist.Runner.IO + Web.Todoist.Runner.IO.Core + Web.Todoist.Runner.IO.Interpreters + Web.Todoist.Runner.Trace + + default-language: Haskell2010 + default-extensions: + InstanceSigs + OverloadedStrings + NoImplicitPrelude + + build-depends: + , aeson >=2.2.3.0 && <2.3 + , base >=4.7 && <5 + , bytestring >=0.12.2.0 && <0.12.3 + , microlens >=0.4.13 && <0.5 + , req >=3.13.4 && <3.14 + , text >=2.1.2 && <2.2 + , todoist-sdk-internal + , transformers >=0.6.1.1 && <0.6.2.0 + + ghc-options: + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints + +test-suite todoist-sdk-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + other-modules: + Web.Todoist.TestHelpers + Web.Todoist.Runner.TodoistIOSpec + Web.Todoist.Runner.TodoistIO.TaskSpec + Web.Todoist.Runner.TodoistIO.CommentSpec + Web.Todoist.Runner.TodoistIO.SectionSpec + Web.Todoist.Runner.TodoistIO.LabelSpec + Web.Todoist.BuilderSpec + + default-language: Haskell2010 + default-extensions: + InstanceSigs + OverloadedStrings + NoImplicitPrelude + + build-depends: + , aeson >=2.2.3.0 && <2.3 + , base >=4.7 && <5 + , bytestring >=0.12.2.0 && <0.12.3 + , hspec >=2.11 + , hspec-discover >=2.11 + , text >=2.1.2 && <2.2 + , todoist-sdk + , todoist-sdk-internal + + build-tool-depends: hspec-discover:hspec-discover + ghc-options: + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints + -threaded + -rtsopts + -with-rtsopts=-N + +test-suite integration-tests + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: integration-test + other-modules: + ProjectIntegrationSpec + TaskIntegrationSpec + CommentIntegrationSpec + SectionIntegrationSpec + LabelIntegrationSpec + Helpers + + default-language: Haskell2010 + default-extensions: + InstanceSigs + OverloadedStrings + NoImplicitPrelude + + build-depends: + , base >=4.7 && <5 + , dotenv >=0.11 + , hspec >=2.11 + , hspec-discover >=2.11 + , random >=1.2 + , text >=2.1.2 && <2.2 + , todoist-sdk + , todoist-sdk-internal + , transformers >=0.6.1.1 && <0.6.2.0 + + build-tool-depends: hspec-discover:hspec-discover + ghc-options: + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints + -threaded + -rtsopts + -with-rtsopts=-N