{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-------------------------------------------
-- |
-- Module      : Pinboard.ApiRequest
-- Copyright   : (c) Jon Schoning, 2015
-- Maintainer  : jonschoning@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- These request builders allow you to build request params which can 
-- sent via Pinboard.Client, in the case you need more control
-- for how the response should be processed over what Pinboard.Api provides.
module Pinboard.ApiRequest
  ( 
    -- ** Posts
    getPostsRecentRequest
  , getPostsForDateRequest
  , getPostsAllRequest
  , getPostsDatesRequest
  , getPostsMRUTimeRequest
  , getSuggestedTagsRequest
  , addPostRequest
  , addPostRecRequest
  , deletePostRequest
   -- ** Tags
  , getTagsRequest
  , renameTagRequest
  , deleteTagRequest
   -- ** User
  , getUserSecretRssKeyRequest
  , getUserApiTokenRequest
   -- ** Notes
  , getNoteListRequest
  , getNoteRequest
  ) where


import Pinboard.Types
       (PinboardRequest(..), Param(..), ResultFormatType(..))

import Pinboard.Util ((</>))
import Data.Text (unwords)
import Data.Maybe (catMaybes)
import Pinboard.ApiTypes

import Control.Applicative
import Prelude hiding (unwords)

-- POSTS ---------------------------------------------------------------------
-- | posts/recent : Returns a list of the user's most recent posts, filtered by tag.
getPostsRecentRequest
  :: ResultFormatType
  -> Maybe [Tag] -- ^ filter by up to three tags
  -> Maybe Count -- ^ number of results to return. Default is 15, max is 100  
  -> PinboardRequest
getPostsRecentRequest :: ResultFormatType -> Maybe [Tag] -> Maybe Count -> PinboardRequest
getPostsRecentRequest ResultFormatType
fmt Maybe [Tag]
tags Maybe Count
count = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"posts/recent"
    params :: [Param]
params =
      [Maybe Param] -> [Param]
forall a. [Maybe a] -> [a]
catMaybes [Param -> Maybe Param
forall a. a -> Maybe a
Just (ResultFormatType -> Param
Format ResultFormatType
fmt), Tag -> Param
Tag (Tag -> Param) -> ([Tag] -> Tag) -> [Tag] -> Param
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag] -> Tag
unwords ([Tag] -> Param) -> Maybe [Tag] -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Tag]
tags, Count -> Param
Count (Count -> Param) -> Maybe Count -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Count
count]

-- | posts/all : Returns all bookmarks in the user's account.
getPostsAllRequest
  :: ResultFormatType
  -> Maybe [Tag] -- ^ filter by up to three tags
  -> Maybe StartOffset -- ^ offset value (default is 0)
  -> Maybe NumResults -- ^ number of results to return. Default is all
  -> Maybe FromDateTime -- ^ return only bookmarks created after this time
  -> Maybe ToDateTime -- ^ return only bookmarks created before this time
  -> Maybe Meta -- ^ include a change detection signature for each bookmark
  -> PinboardRequest
getPostsAllRequest :: ResultFormatType
-> Maybe [Tag]
-> Maybe Count
-> Maybe Count
-> Maybe FromDateTime
-> Maybe FromDateTime
-> Maybe Count
-> PinboardRequest
getPostsAllRequest ResultFormatType
fmt Maybe [Tag]
tags Maybe Count
start Maybe Count
results Maybe FromDateTime
fromdt Maybe FromDateTime
todt Maybe Count
meta =
  Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"posts/all"
    params :: [Param]
params =
      [Maybe Param] -> [Param]
forall a. [Maybe a] -> [a]
catMaybes
        [ Param -> Maybe Param
forall a. a -> Maybe a
Just (ResultFormatType -> Param
Format ResultFormatType
fmt)
        , Tag -> Param
Tag (Tag -> Param) -> ([Tag] -> Tag) -> [Tag] -> Param
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag] -> Tag
unwords ([Tag] -> Param) -> Maybe [Tag] -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Tag]
tags
        , Count -> Param
Start (Count -> Param) -> Maybe Count -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Count
start
        , Count -> Param
Results (Count -> Param) -> Maybe Count -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Count
results
        , FromDateTime -> Param
FromDateTime (FromDateTime -> Param) -> Maybe FromDateTime -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FromDateTime
fromdt
        , FromDateTime -> Param
ToDateTime (FromDateTime -> Param) -> Maybe FromDateTime -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FromDateTime
todt
        , Count -> Param
Meta (Count -> Param) -> Maybe Count -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Count
meta
        ]

-- | posts/get : Returns one or more posts on a single day matching the arguments. 
-- If no date or url is given, date of most recent bookmark will be used.
getPostsForDateRequest
  :: ResultFormatType
  -> Maybe [Tag] -- ^ filter by up to three tags
  -> Maybe Date -- ^ return results bookmarked on this day
  -> Maybe Url -- ^ return bookmark for this URL
  -> PinboardRequest
getPostsForDateRequest :: ResultFormatType
-> Maybe [Tag] -> Maybe Date -> Maybe Tag -> PinboardRequest
getPostsForDateRequest ResultFormatType
fmt Maybe [Tag]
tags Maybe Date
date Maybe Tag
url = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"posts/get"
    params :: [Param]
params =
      [Maybe Param] -> [Param]
forall a. [Maybe a] -> [a]
catMaybes
        [Param -> Maybe Param
forall a. a -> Maybe a
Just (ResultFormatType -> Param
Format ResultFormatType
fmt), Tag -> Param
Tag (Tag -> Param) -> ([Tag] -> Tag) -> [Tag] -> Param
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag] -> Tag
unwords ([Tag] -> Param) -> Maybe [Tag] -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Tag]
tags, Date -> Param
Date (Date -> Param) -> Maybe Date -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Date
date, Tag -> Param
Url (Tag -> Param) -> Maybe Tag -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Tag
url]

-- | posts/dates : Returns a list of dates with the number of posts at each date.
getPostsDatesRequest
  :: ResultFormatType
  -> Maybe [Tag] -- ^ filter by up to three tags
  -> PinboardRequest
getPostsDatesRequest :: ResultFormatType -> Maybe [Tag] -> PinboardRequest
getPostsDatesRequest ResultFormatType
fmt Maybe [Tag]
tags = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"posts/dates"
    params :: [Param]
params = [Maybe Param] -> [Param]
forall a. [Maybe a] -> [a]
catMaybes [Param -> Maybe Param
forall a. a -> Maybe a
Just (ResultFormatType -> Param
Format ResultFormatType
fmt), Tag -> Param
Tag (Tag -> Param) -> ([Tag] -> Tag) -> [Tag] -> Param
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag] -> Tag
unwords ([Tag] -> Param) -> Maybe [Tag] -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Tag]
tags]

-- | posts/update : Returns the most recent time a bookmark was added, updated or deleted.
getPostsMRUTimeRequest :: ResultFormatType -> PinboardRequest
getPostsMRUTimeRequest :: ResultFormatType -> PinboardRequest
getPostsMRUTimeRequest ResultFormatType
fmt = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"posts/update"
    params :: [Param]
params = [ResultFormatType -> Param
Format ResultFormatType
fmt]

-- | posts/suggest : Returns a list of popular tags and recommended tags for a given URL. 
-- Popular tags are tags used site-wide for the url; 
-- Recommended tags are drawn from the user's own tags.
getSuggestedTagsRequest :: ResultFormatType -> Url -> PinboardRequest
getSuggestedTagsRequest :: ResultFormatType -> Tag -> PinboardRequest
getSuggestedTagsRequest ResultFormatType
fmt Tag
url = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"posts/suggest"
    params :: [Param]
params = [ResultFormatType -> Param
Format ResultFormatType
fmt, Tag -> Param
Url Tag
url]

-- | posts/delete : Delete an existing bookmark.
deletePostRequest :: ResultFormatType -> Url -> PinboardRequest
deletePostRequest :: ResultFormatType -> Tag -> PinboardRequest
deletePostRequest ResultFormatType
fmt Tag
url = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"posts/delete"
    params :: [Param]
params = [ResultFormatType -> Param
Format ResultFormatType
fmt, Tag -> Param
Url Tag
url]

-- | posts/add : Add or Update a bookmark
addPostRequest
  :: ResultFormatType
  -> Url -- ^ the URL of the item
  -> Description -- ^ Title of the item. This field is unfortunately named 'description' for backwards compatibility with the delicious API
  -> Maybe Extended -- ^ Description of the item. Called 'extended' for backwards compatibility with delicious API
  -> Maybe [Tag] -- ^ List of up to 100 tags
  -> Maybe DateTime -- ^ creation time for this bookmark. Defaults to current time. Datestamps more than 10 minutes ahead of server time will be reset to current server time
  -> Maybe Replace -- ^ Replace any existing bookmark with this URL. Default is yes. If set to no, will throw an error if bookmark exists
  -> Maybe Shared -- ^ Make bookmark public. Default is "yes" unless user has enabled the "save all bookmarks as private" user setting, in which case default is "no"
  -> Maybe ToRead -- ^ Marks the bookmark as unread. Default is "no"
  -> PinboardRequest
addPostRequest :: ResultFormatType
-> Tag
-> Tag
-> Maybe Tag
-> Maybe [Tag]
-> Maybe FromDateTime
-> Maybe Replace
-> Maybe Replace
-> Maybe Replace
-> PinboardRequest
addPostRequest ResultFormatType
fmt Tag
url Tag
descr Maybe Tag
ext Maybe [Tag]
tags Maybe FromDateTime
ctime Maybe Replace
repl Maybe Replace
shared Maybe Replace
toread =
  Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"posts/add"
    params :: [Param]
params =
      [Maybe Param] -> [Param]
forall a. [Maybe a] -> [a]
catMaybes
        [ Param -> Maybe Param
forall a. a -> Maybe a
Just (ResultFormatType -> Param
Format ResultFormatType
fmt)
        , Param -> Maybe Param
forall a. a -> Maybe a
Just (Param -> Maybe Param) -> Param -> Maybe Param
forall a b. (a -> b) -> a -> b
$ Tag -> Param
Url Tag
url
        , Param -> Maybe Param
forall a. a -> Maybe a
Just (Param -> Maybe Param) -> Param -> Maybe Param
forall a b. (a -> b) -> a -> b
$ Tag -> Param
Description Tag
descr
        , Tag -> Param
Extended (Tag -> Param) -> Maybe Tag -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Tag
ext
        , Tag -> Param
Tags (Tag -> Param) -> ([Tag] -> Tag) -> [Tag] -> Param
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag] -> Tag
unwords ([Tag] -> Param) -> Maybe [Tag] -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Tag]
tags
        , FromDateTime -> Param
DateTime (FromDateTime -> Param) -> Maybe FromDateTime -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FromDateTime
ctime
        , Replace -> Param
Replace (Replace -> Param) -> Maybe Replace -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Replace
repl
        , Replace -> Param
Shared (Replace -> Param) -> Maybe Replace -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Replace
shared
        , Replace -> Param
ToRead (Replace -> Param) -> Maybe Replace -> Maybe Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Replace
toread
        ]

-- | posts/add : Add or Update a bookmark (from a Post record)
addPostRecRequest
  :: ResultFormatType
  -> Post -- ^ the Post record
  -> Replace -- ^ Replace any existing bookmark with the Posts URL. If set to no, will throw an error if bookmark exists 
  -> PinboardRequest
addPostRecRequest :: ResultFormatType -> Post -> Replace -> PinboardRequest
addPostRecRequest ResultFormatType
fmt Post {Replace
[Tag]
Tag
FromDateTime
postTags :: Post -> [Tag]
postToRead :: Post -> Replace
postShared :: Post -> Replace
postTime :: Post -> FromDateTime
postHash :: Post -> Tag
postMeta :: Post -> Tag
postExtended :: Post -> Tag
postDescription :: Post -> Tag
postHref :: Post -> Tag
postTags :: [Tag]
postToRead :: Replace
postShared :: Replace
postTime :: FromDateTime
postHash :: Tag
postMeta :: Tag
postExtended :: Tag
postDescription :: Tag
postHref :: Tag
..} Replace
replace =
  ResultFormatType
-> Tag
-> Tag
-> Maybe Tag
-> Maybe [Tag]
-> Maybe FromDateTime
-> Maybe Replace
-> Maybe Replace
-> Maybe Replace
-> PinboardRequest
addPostRequest
    ResultFormatType
fmt
    Tag
postHref
    Tag
postDescription
    (Tag -> Maybe Tag
forall a. a -> Maybe a
Just Tag
postExtended)
    ([Tag] -> Maybe [Tag]
forall a. a -> Maybe a
Just [Tag]
postTags)
    (FromDateTime -> Maybe FromDateTime
forall a. a -> Maybe a
Just FromDateTime
postTime)
    (Replace -> Maybe Replace
forall a. a -> Maybe a
Just Replace
replace)
    (Replace -> Maybe Replace
forall a. a -> Maybe a
Just Replace
postShared)
    (Replace -> Maybe Replace
forall a. a -> Maybe a
Just Replace
postToRead)

-- TAGS ----------------------------------------------------------------------
-- | tags/get : Returns a full list of the user's tags along with the number of 
-- times they were used.
getTagsRequest :: ResultFormatType -> PinboardRequest
getTagsRequest :: ResultFormatType -> PinboardRequest
getTagsRequest ResultFormatType
fmt = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"tags/get"
    params :: [Param]
params = [ResultFormatType -> Param
Format ResultFormatType
fmt]

-- | tags/delete : Delete an existing tag.
deleteTagRequest :: ResultFormatType -> Tag -> PinboardRequest
deleteTagRequest :: ResultFormatType -> Tag -> PinboardRequest
deleteTagRequest ResultFormatType
fmt Tag
tag = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"tags/delete"
    params :: [Param]
params = [ResultFormatType -> Param
Format ResultFormatType
fmt, Tag -> Param
Tag Tag
tag]

-- | tags/rename : Rename an tag, or fold it in to an existing tag
renameTagRequest
  :: ResultFormatType
  -> Old -- ^ note: match is not case sensitive
  -> New -- ^ if empty, nothing will happen
  -> PinboardRequest
renameTagRequest :: ResultFormatType -> Tag -> Tag -> PinboardRequest
renameTagRequest ResultFormatType
fmt Tag
old Tag
new = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"tags/rename"
    params :: [Param]
params = [ResultFormatType -> Param
Format ResultFormatType
fmt, Tag -> Param
Old Tag
old, Tag -> Param
New Tag
new]

-- USER ----------------------------------------------------------------------
-- | user/secret : Returns the user's secret RSS key (for viewing private feeds)
getUserSecretRssKeyRequest :: ResultFormatType -> PinboardRequest
getUserSecretRssKeyRequest :: ResultFormatType -> PinboardRequest
getUserSecretRssKeyRequest ResultFormatType
fmt = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"user/secret"
    params :: [Param]
params = [ResultFormatType -> Param
Format ResultFormatType
fmt]

-- | user/api_token : Returns the user's API token (for making API calls without a password)
getUserApiTokenRequest :: ResultFormatType -> PinboardRequest
getUserApiTokenRequest :: ResultFormatType -> PinboardRequest
getUserApiTokenRequest ResultFormatType
fmt = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"user/api_token"
    params :: [Param]
params = [ResultFormatType -> Param
Format ResultFormatType
fmt]

-- NOTES ---------------------------------------------------------------------
-- | notes/list : Returns a list of the user's notes (note text detail is not included)
getNoteListRequest :: ResultFormatType -> PinboardRequest
getNoteListRequest :: ResultFormatType -> PinboardRequest
getNoteListRequest ResultFormatType
fmt = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"notes/list"
    params :: [Param]
params = [ResultFormatType -> Param
Format ResultFormatType
fmt]

-- | notes/id : Returns an individual user note. The hash property is a 20 character long sha1 hash of the note text.
getNoteRequest :: ResultFormatType -> NoteId -> PinboardRequest
getNoteRequest :: ResultFormatType -> Tag -> PinboardRequest
getNoteRequest ResultFormatType
fmt Tag
noteid = Tag -> [Param] -> PinboardRequest
PinboardRequest Tag
path [Param]
params
  where
    path :: Tag
path = Tag
"notes" Tag -> Tag -> Tag
forall m. (Monoid m, IsString m) => m -> m -> m
</> Tag
noteid
    params :: [Param]
params = [ResultFormatType -> Param
Format ResultFormatType
fmt]