diff --git a/pinboard.cabal b/pinboard.cabal --- a/pinboard.cabal +++ b/pinboard.cabal @@ -1,5 +1,5 @@ name: pinboard -version: 0.3 +version: 0.4 synopsis: Access to the Pinboard API license: MIT license-file: LICENSE @@ -55,6 +55,7 @@ exposed-modules: Pinboard Pinboard.Api + Pinboard.ApiRequest Pinboard.ApiTypes Pinboard.Client Pinboard.Client.Internal diff --git a/src/Pinboard.hs b/src/Pinboard.hs --- a/src/Pinboard.hs +++ b/src/Pinboard.hs @@ -25,6 +25,7 @@ -- * Pinboard.Api -- | Provides Pinboard Api Methods , module Pinboard.Api + , module Pinboard.ApiRequest -- * Pinboard.ApiTypes -- | Pinboard Data Structures returned by the Api , module Pinboard.ApiTypes @@ -32,4 +33,5 @@ import Pinboard.Client import Pinboard.Api +import Pinboard.ApiRequest import Pinboard.ApiTypes diff --git a/src/Pinboard/Api.hs b/src/Pinboard/Api.hs --- a/src/Pinboard/Api.hs +++ b/src/Pinboard/Api.hs @@ -33,28 +33,22 @@ getNote, ) where -import Prelude hiding (unwords) import Pinboard.Client.Internal (pinboardJson) -import Pinboard.Client.Types (Pinboard, PinboardRequest (..), Param (..)) -import Pinboard.Client.Util (()) +import Pinboard.Client.Types (Pinboard) import Control.Applicative ((<$>)) -import Data.Text (Text, unwords) +import Data.Text (Text) import Data.Time (UTCTime) -import Data.Maybe (catMaybes) import Pinboard.ApiTypes +import Pinboard.ApiRequest -- POSTS --------------------------------------------------------------------- -- | posts/recent : Returns a list of the user's most recent posts, filtered by tag. -getPostsRecent +getPostsRecent :: Maybe [Tag] -- ^ filter by up to three tags -> Maybe Count -- ^ number of results to return. Default is 15, max is 100 -> Pinboard Posts -getPostsRecent tags count = pinboardJson (PinboardRequest path params) - where - path = "posts/recent" - params = catMaybes [ Tag . unwords <$> tags - , Count <$> count ] +getPostsRecent tags count = pinboardJson $ getPostsRecentRequest tags count -- | posts/all : Returns all bookmarks in the user's account. getPostsAll @@ -65,17 +59,7 @@ -> Maybe ToDateTime -- ^ return only bookmarks created before this time -> Maybe Meta -- ^ include a change detection signature for each bookmark -> Pinboard [Post] -getPostsAll tags start results fromdt todt meta = - pinboardJson (PinboardRequest path params) - where - path = "posts/all" - params = catMaybes [ Tag . unwords <$> tags - , Start <$> start - , Results <$> results - , FromDateTime <$> fromdt - , ToDateTime <$> todt - , Meta <$> meta - ] +getPostsAll tags start results fromdt todt meta = pinboardJson $ getPostsAllRequest tags start results fromdt todt 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. @@ -84,30 +68,18 @@ -> Maybe Date -- ^ return results bookmarked on this day -> Maybe Url -- ^ return bookmark for this URL -> Pinboard Posts -getPostsForDate tags date url = pinboardJson (PinboardRequest path params) - where - path = "posts/get" - params = catMaybes [ Tag . unwords <$> tags - , Date <$> date - , Url <$> url ] - +getPostsForDate tags date url = pinboardJson $ getPostsForDateRequest tags date url -- | posts/dates : Returns a list of dates with the number of posts at each date. getPostsDates :: Maybe [Tag] -- ^ filter by up to three tags -> Pinboard PostDates -getPostsDates tags = pinboardJson (PinboardRequest path params) - where - path = "posts/dates" - params = catMaybes [ Tag . unwords <$> tags ] +getPostsDates tags = pinboardJson $ getPostsDatesRequest tags -- | posts/update : Returns the most recent time a bookmark was added, updated or deleted. getPostsMRUTime :: Pinboard UTCTime -getPostsMRUTime = fromUpdateTime <$> pinboardJson (PinboardRequest path params) - where - path = "posts/update" - params = [] +getPostsMRUTime = fromUpdateTime <$> pinboardJson getPostsMRUTimeRequest -- | 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; @@ -115,20 +87,13 @@ getSuggestedTags :: Url -> Pinboard [Suggested] -getSuggestedTags url = pinboardJson (PinboardRequest path params) - where - path = "posts/suggest" - params = [ Url url ] +getSuggestedTags url = pinboardJson $ getSuggestedTagsRequest url -- | posts/delete : Delete an existing bookmark. deletePost :: Url -> Pinboard () -deletePost url = fromDoneResult <$> pinboardJson (PinboardRequest path params) - where - path = "posts/delete" - params = [Url url] - +deletePost url = fromDoneResult <$> (pinboardJson $ deletePostRequest url) -- | posts/add : Add a bookmark addPost @@ -141,39 +106,23 @@ -> 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" -> Pinboard () -addPost url descr ext tags ctime repl shared toread = - fromDoneResult <$> pinboardJson (PinboardRequest path params) - where - path = "posts/add" - params = catMaybes [ Just $ Url url - , Just $ Description descr - , Extended <$> ext - , Tags . unwords <$> tags - , DateTime <$> ctime - , Replace <$> repl - , Shared <$> shared - , ToRead <$> toread ] +addPost url descr ext tags ctime repl shared toread = fromDoneResult <$> (pinboardJson $ addPostRequest url descr ext tags ctime repl shared toread) -- TAGS ---------------------------------------------------------------------- -- | tags/get : Returns a full list of the user's tags along with the number of -- times they were used. -getTags :: Pinboard TagMap -getTags = fromJsonTagMap <$> pinboardJson (PinboardRequest path params) - where - path = "tags/get" - params = [] +getTags + :: Pinboard TagMap +getTags = fromJsonTagMap <$> (pinboardJson $ getTagsRequest) -- | tags/delete : Delete an existing tag. deleteTag :: Tag -> Pinboard () -deleteTag tag = fromDoneResult <$> pinboardJson (PinboardRequest path params) - where - path = "tags/delete" - params = [Tag tag] +deleteTag tag = fromDoneResult <$> (pinboardJson $ deleteTagRequest tag) -- | tags/rename : Rename an tag, or fold it in to an existing tag @@ -181,44 +130,32 @@ :: Old -- ^ note: match is not case sensitive -> New -- ^ if empty, nothing will happen -> Pinboard () -renameTag old new = fromDoneResult <$> pinboardJson (PinboardRequest path params) - where - path = "tags/rename" - params = [Old old, New new] +renameTag old new = fromDoneResult <$> (pinboardJson $ renameTagRequest old new) -- USER ---------------------------------------------------------------------- -- | user/secret : Returns the user's secret RSS key (for viewing private feeds) -getUserSecretRssKey :: Pinboard Text -getUserSecretRssKey = fromTextResult <$> pinboardJson (PinboardRequest path params) - where - path = "user/secret" - params = [] +getUserSecretRssKey + :: Pinboard Text +getUserSecretRssKey = fromTextResult <$> (pinboardJson $ getUserSecretRssKeyRequest) -- | user/api_token : Returns the user's API token (for making API calls without a password) -getUserApiToken :: Pinboard Text -getUserApiToken = fromTextResult <$> pinboardJson (PinboardRequest path params) - where - path = "user/api_token" - params = [] +getUserApiToken + :: Pinboard Text +getUserApiToken = fromTextResult <$> (pinboardJson $ getUserApiTokenRequest) -- NOTES --------------------------------------------------------------------- -- | notes/list : Returns a list of the user's notes (note text detail is not included) -getNoteList :: Pinboard NoteList -getNoteList = pinboardJson (PinboardRequest path params) - where - path = "notes/list" - params = [] +getNoteList + :: Pinboard NoteList +getNoteList = pinboardJson $ getNoteListRequest -- | notes/id : Returns an individual user note. The hash property is a 20 character long sha1 hash of the note text. getNote :: NoteId -> Pinboard Note -getNote noteid = pinboardJson (PinboardRequest path params) - where - path = "notes" noteid - params = [] +getNote noteid = pinboardJson $ getNoteRequest noteid diff --git a/src/Pinboard/ApiRequest.hs b/src/Pinboard/ApiRequest.hs new file mode 100644 --- /dev/null +++ b/src/Pinboard/ApiRequest.hs @@ -0,0 +1,229 @@ +{-# LANGUAGE OverloadedStrings #-} + +------------------------------------------- +-- | +-- 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.Internal, 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, + deletePostRequest, + -- ** Tags + getTagsRequest, + renameTagRequest, + deleteTagRequest, + -- ** User + getUserSecretRssKeyRequest, + getUserApiTokenRequest, + -- ** Notes + getNoteListRequest, + getNoteRequest, + ) where + +import Prelude hiding (unwords) +import Pinboard.Client.Types (PinboardRequest (..), Param (..)) +import Pinboard.Client.Util (()) +import Control.Applicative ((<$>)) +import Data.Text (unwords) +import Data.Maybe (catMaybes) +import Pinboard.ApiTypes + +-- POSTS --------------------------------------------------------------------- + +-- | posts/recent : Returns a list of the user's most recent posts, filtered by tag. +getPostsRecentRequest + :: Maybe [Tag] -- ^ filter by up to three tags + -> Maybe Count -- ^ number of results to return. Default is 15, max is 100 + -> PinboardRequest +getPostsRecentRequest tags count = PinboardRequest path params + where + path = "posts/recent" + params = catMaybes [ Tag . unwords <$> tags + , Count <$> count ] + +-- | posts/all : Returns all bookmarks in the user's account. +getPostsAllRequest + :: 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 tags start results fromdt todt meta = + PinboardRequest path params + where + path = "posts/all" + params = catMaybes [ Tag . unwords <$> tags + , Start <$> start + , Results <$> results + , FromDateTime <$> fromdt + , ToDateTime <$> todt + , Meta <$> 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 + :: 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 tags date url = PinboardRequest path params + where + path = "posts/get" + params = catMaybes [ Tag . unwords <$> tags + , Date <$> date + , Url <$> url ] + + +-- | posts/dates : Returns a list of dates with the number of posts at each date. +getPostsDatesRequest + :: Maybe [Tag] -- ^ filter by up to three tags + -> PinboardRequest +getPostsDatesRequest tags = PinboardRequest path params + where + path = "posts/dates" + params = catMaybes [ Tag . unwords <$> tags ] + + +-- | posts/update : Returns the most recent time a bookmark was added, updated or deleted. +getPostsMRUTimeRequest + :: PinboardRequest +getPostsMRUTimeRequest = PinboardRequest path params + where + path = "posts/update" + params = [] + +-- | 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 + :: Url + -> PinboardRequest +getSuggestedTagsRequest url = PinboardRequest path params + where + path = "posts/suggest" + params = [ Url url ] + +-- | posts/delete : Delete an existing bookmark. +deletePostRequest + :: Url + -> PinboardRequest +deletePostRequest url = PinboardRequest path params + where + path = "posts/delete" + params = [Url url] + + +-- | posts/add : Add a bookmark +addPostRequest + :: 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 url descr ext tags ctime repl shared toread = + PinboardRequest path params + where + path = "posts/add" + params = catMaybes [ Just $ Url url + , Just $ Description descr + , Extended <$> ext + , Tags . unwords <$> tags + , DateTime <$> ctime + , Replace <$> repl + , Shared <$> shared + , ToRead <$> toread ] + +-- TAGS ---------------------------------------------------------------------- + + +-- | tags/get : Returns a full list of the user's tags along with the number of +-- times they were used. +getTagsRequest + :: PinboardRequest +getTagsRequest = PinboardRequest path params + where + path = "tags/get" + params = [] + + +-- | tags/delete : Delete an existing tag. +deleteTagRequest + :: Tag + -> PinboardRequest +deleteTagRequest tag = PinboardRequest path params + where + path = "tags/delete" + params = [Tag tag] + + +-- | tags/rename : Rename an tag, or fold it in to an existing tag +renameTagRequest + :: Old -- ^ note: match is not case sensitive + -> New -- ^ if empty, nothing will happen + -> PinboardRequest +renameTagRequest old new = PinboardRequest path params + where + path = "tags/rename" + params = [Old old, New new] + + +-- USER ---------------------------------------------------------------------- + +-- | user/secret : Returns the user's secret RSS key (for viewing private feeds) +getUserSecretRssKeyRequest + :: PinboardRequest +getUserSecretRssKeyRequest = PinboardRequest path params + where + path = "user/secret" + params = [] + +-- | user/api_token : Returns the user's API token (for making API calls without a password) +getUserApiTokenRequest + :: PinboardRequest +getUserApiTokenRequest = PinboardRequest path params + where + path = "user/api_token" + params = [] + + +-- NOTES --------------------------------------------------------------------- + +-- | notes/list : Returns a list of the user's notes (note text detail is not included) +getNoteListRequest + :: PinboardRequest +getNoteListRequest = PinboardRequest path params + where + path = "notes/list" + params = [] + +-- | notes/id : Returns an individual user note. The hash property is a 20 character long sha1 hash of the note text. +getNoteRequest + :: NoteId + -> PinboardRequest +getNoteRequest noteid = PinboardRequest path params + where + path = "notes" noteid + params = [] + diff --git a/src/Pinboard/Client/Internal.hs b/src/Pinboard/Client/Internal.hs --- a/src/Pinboard/Client/Internal.hs +++ b/src/Pinboard/Client/Internal.hs @@ -149,7 +149,7 @@ buildReq url = buildRequest $ do http GET ("/v1/" <> url) setHeader "Connection" "Keep-Alive" - setHeader "User-Agent" "pinboard.hs/0.3" + setHeader "User-Agent" "pinboard.hs/0.4" --------------------------------------------------------------------------------