Project.hs

{-# 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: <https://developer.todoist.com/rest/v2/#projects>
-}
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