{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}

-------------------------------------------
-- |
-- Module      : Pinboard.Api
-- Copyright   : (c) Jon Schoning, 2015
-- Maintainer  : jonschoning@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- < https://pinboard.in/api/ >
--
-- Provides Pinboard Api Access (deserializes into Haskell data structures)
module Pinboard.Api
  ( -- ** Posts
    getPostsRecent
  , getPostsForDate
  , getPostsAll
  , getPostsDates
  , getPostsMRUTime
  , getSuggestedTags
  , addPost
  , addPostRec
  , deletePost
   -- ** Tags
  , getTags
  , renameTag
  , deleteTag
   -- ** User
  , getUserSecretRssKey
  , getUserApiToken
   -- ** Notes
  , getNoteList
  , getNote
  ) where


import Pinboard.Client (pinboardJson)
import Data.Text (Text)
import Data.Time (UTCTime)
import Pinboard.Types (MonadPinboard, ResultFormatType(..))
import Pinboard.ApiTypes
import Pinboard.ApiRequest
import Pinboard.Error

import Control.Applicative
import Prelude

-- POSTS ---------------------------------------------------------------------
-- | posts/recent : Returns a list of the user's most recent posts, filtered by tag.
getPostsRecent
  :: MonadPinboard m
  => Maybe [Tag] -- ^ filter by up to three tags
  -> Maybe Count -- ^ number of results to return. Default is 15, max is 100  
  -> m (Either PinboardError Posts)
getPostsRecent :: Maybe [Tag] -> Maybe Count -> m (Either PinboardError Posts)
getPostsRecent Maybe [Tag]
tags Maybe Count
count =
  PinboardRequest -> m (Either PinboardError Posts)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (PinboardRequest -> m (Either PinboardError Posts))
-> PinboardRequest -> m (Either PinboardError Posts)
forall a b. (a -> b) -> a -> b
$ ResultFormatType -> Maybe [Tag] -> Maybe Count -> PinboardRequest
getPostsRecentRequest ResultFormatType
FormatJson Maybe [Tag]
tags Maybe Count
count

-- | posts/all : Returns all bookmarks in the user's account.
getPostsAll
  :: MonadPinboard m
  => 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
  -> m (Either PinboardError [Post])
getPostsAll :: Maybe [Tag]
-> Maybe Count
-> Maybe Count
-> Maybe FromDateTime
-> Maybe FromDateTime
-> Maybe Count
-> m (Either PinboardError [Post])
getPostsAll Maybe [Tag]
tags Maybe Count
start Maybe Count
results Maybe FromDateTime
fromdt Maybe FromDateTime
todt Maybe Count
meta =
  PinboardRequest -> m (Either PinboardError [Post])
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (PinboardRequest -> m (Either PinboardError [Post]))
-> PinboardRequest -> m (Either PinboardError [Post])
forall a b. (a -> b) -> a -> b
$ ResultFormatType
-> Maybe [Tag]
-> Maybe Count
-> Maybe Count
-> Maybe FromDateTime
-> Maybe FromDateTime
-> Maybe Count
-> PinboardRequest
getPostsAllRequest ResultFormatType
FormatJson Maybe [Tag]
tags Maybe Count
start Maybe Count
results Maybe FromDateTime
fromdt Maybe FromDateTime
todt 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.
getPostsForDate
  :: MonadPinboard m
  => Maybe [Tag] -- ^ filter by up to three tags
  -> Maybe Date -- ^ return results bookmarked on this day
  -> Maybe Url -- ^ return bookmark for this URL
  -> m (Either PinboardError Posts)
getPostsForDate :: Maybe [Tag]
-> Maybe Date -> Maybe Tag -> m (Either PinboardError Posts)
getPostsForDate Maybe [Tag]
tags Maybe Date
date Maybe Tag
url =
  PinboardRequest -> m (Either PinboardError Posts)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (PinboardRequest -> m (Either PinboardError Posts))
-> PinboardRequest -> m (Either PinboardError Posts)
forall a b. (a -> b) -> a -> b
$ ResultFormatType
-> Maybe [Tag] -> Maybe Date -> Maybe Tag -> PinboardRequest
getPostsForDateRequest ResultFormatType
FormatJson Maybe [Tag]
tags Maybe Date
date Maybe Tag
url

-- | posts/dates : Returns a list of dates with the number of posts at each date.
getPostsDates
  :: MonadPinboard m
  => Maybe [Tag] -- ^ filter by up to three tags
  -> m (Either PinboardError PostDates)
getPostsDates :: Maybe [Tag] -> m (Either PinboardError PostDates)
getPostsDates Maybe [Tag]
tags = PinboardRequest -> m (Either PinboardError PostDates)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (PinboardRequest -> m (Either PinboardError PostDates))
-> PinboardRequest -> m (Either PinboardError PostDates)
forall a b. (a -> b) -> a -> b
$ ResultFormatType -> Maybe [Tag] -> PinboardRequest
getPostsDatesRequest ResultFormatType
FormatJson Maybe [Tag]
tags

-- | posts/update : Returns the most recent time a bookmark was added, updated or deleted.
getPostsMRUTime
  :: MonadPinboard m
  => m (Either PinboardError UTCTime)
getPostsMRUTime :: m (Either PinboardError FromDateTime)
getPostsMRUTime =
  (UpdateTime -> FromDateTime)
-> Either PinboardError UpdateTime
-> Either PinboardError FromDateTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UpdateTime -> FromDateTime
fromUpdateTime (Either PinboardError UpdateTime
 -> Either PinboardError FromDateTime)
-> m (Either PinboardError UpdateTime)
-> m (Either PinboardError FromDateTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PinboardRequest -> m (Either PinboardError UpdateTime)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (ResultFormatType -> PinboardRequest
getPostsMRUTimeRequest ResultFormatType
FormatJson)

-- | 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.
getSuggestedTags
  :: MonadPinboard m
  => Url -> m (Either PinboardError [Suggested])
getSuggestedTags :: Tag -> m (Either PinboardError [Suggested])
getSuggestedTags Tag
url = PinboardRequest -> m (Either PinboardError [Suggested])
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (PinboardRequest -> m (Either PinboardError [Suggested]))
-> PinboardRequest -> m (Either PinboardError [Suggested])
forall a b. (a -> b) -> a -> b
$ ResultFormatType -> Tag -> PinboardRequest
getSuggestedTagsRequest ResultFormatType
FormatJson Tag
url

-- | posts/delete : Delete an existing bookmark.
deletePost
  :: MonadPinboard m
  => Url -> m (Either PinboardError ())
deletePost :: Tag -> m (Either PinboardError ())
deletePost Tag
url =
  (DoneResult -> ())
-> Either PinboardError DoneResult -> Either PinboardError ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoneResult -> ()
fromDoneResult (Either PinboardError DoneResult -> Either PinboardError ())
-> m (Either PinboardError DoneResult)
-> m (Either PinboardError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PinboardRequest -> m (Either PinboardError DoneResult)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (ResultFormatType -> Tag -> PinboardRequest
deletePostRequest ResultFormatType
FormatJson Tag
url)

-- | posts/add : Add or Update a bookmark
addPost
  :: MonadPinboard m
  => 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 fail 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"
  -> m (Either PinboardError ())
addPost :: Tag
-> Tag
-> Maybe Tag
-> Maybe [Tag]
-> Maybe FromDateTime
-> Maybe Replace
-> Maybe Replace
-> Maybe Replace
-> m (Either PinboardError ())
addPost Tag
url Tag
descr Maybe Tag
ext Maybe [Tag]
tags Maybe FromDateTime
ctime Maybe Replace
repl Maybe Replace
shared Maybe Replace
toread =
  (DoneResult -> ())
-> Either PinboardError DoneResult -> Either PinboardError ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoneResult -> ()
fromDoneResult (Either PinboardError DoneResult -> Either PinboardError ())
-> m (Either PinboardError DoneResult)
-> m (Either PinboardError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  PinboardRequest -> m (Either PinboardError DoneResult)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson
    (ResultFormatType
-> Tag
-> Tag
-> Maybe Tag
-> Maybe [Tag]
-> Maybe FromDateTime
-> Maybe Replace
-> Maybe Replace
-> Maybe Replace
-> PinboardRequest
addPostRequest ResultFormatType
FormatJson Tag
url Tag
descr Maybe Tag
ext Maybe [Tag]
tags Maybe FromDateTime
ctime Maybe Replace
repl Maybe Replace
shared Maybe Replace
toread)

-- | posts/add :  Add or Update a bookmark, from a Post record
addPostRec
  :: MonadPinboard m
  => Post -- ^ a Post record
  -> Replace -- ^ Replace any existing bookmark with the Posts URL. If set to no, will fail if bookmark exists 
  -> m (Either PinboardError ())
addPostRec :: Post -> Replace -> m (Either PinboardError ())
addPostRec Post
post Replace
replace =
  (DoneResult -> ())
-> Either PinboardError DoneResult -> Either PinboardError ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoneResult -> ()
fromDoneResult (Either PinboardError DoneResult -> Either PinboardError ())
-> m (Either PinboardError DoneResult)
-> m (Either PinboardError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PinboardRequest -> m (Either PinboardError DoneResult)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (ResultFormatType -> Post -> Replace -> PinboardRequest
addPostRecRequest ResultFormatType
FormatJson Post
post Replace
replace)

-- TAGS ----------------------------------------------------------------------
-- | tags/get : Returns a full list of the user's tags along with the number of 
-- times they were used.
getTags
  :: MonadPinboard m
  => m (Either PinboardError TagMap)
getTags :: m (Either PinboardError TagMap)
getTags = (JsonTagMap -> TagMap)
-> Either PinboardError JsonTagMap -> Either PinboardError TagMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonTagMap -> TagMap
fromJsonTagMap (Either PinboardError JsonTagMap -> Either PinboardError TagMap)
-> m (Either PinboardError JsonTagMap)
-> m (Either PinboardError TagMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PinboardRequest -> m (Either PinboardError JsonTagMap)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (ResultFormatType -> PinboardRequest
getTagsRequest ResultFormatType
FormatJson)

-- | tags/delete : Delete an existing tag.
deleteTag
  :: MonadPinboard m
  => Tag -> m (Either PinboardError ())
deleteTag :: Tag -> m (Either PinboardError ())
deleteTag Tag
tag =
  (DoneResult -> ())
-> Either PinboardError DoneResult -> Either PinboardError ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoneResult -> ()
fromDoneResult (Either PinboardError DoneResult -> Either PinboardError ())
-> m (Either PinboardError DoneResult)
-> m (Either PinboardError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PinboardRequest -> m (Either PinboardError DoneResult)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (ResultFormatType -> Tag -> PinboardRequest
deleteTagRequest ResultFormatType
FormatJson Tag
tag)

-- | tags/rename : Rename an tag, or fold it in to an existing tag
renameTag
  :: MonadPinboard m
  => Old -- ^ note: match is not case sensitive
  -> New -- ^ if empty, nothing will happen
  -> m (Either PinboardError ())
renameTag :: Tag -> Tag -> m (Either PinboardError ())
renameTag Tag
old Tag
new =
  (DoneResult -> ())
-> Either PinboardError DoneResult -> Either PinboardError ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoneResult -> ()
fromDoneResult (Either PinboardError DoneResult -> Either PinboardError ())
-> m (Either PinboardError DoneResult)
-> m (Either PinboardError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PinboardRequest -> m (Either PinboardError DoneResult)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (ResultFormatType -> Tag -> Tag -> PinboardRequest
renameTagRequest ResultFormatType
FormatJson Tag
old Tag
new)

-- USER ----------------------------------------------------------------------
-- | user/secret : Returns the user's secret RSS key (for viewing private feeds)
getUserSecretRssKey
  :: MonadPinboard m
  => m (Either PinboardError Text)
getUserSecretRssKey :: m (Either PinboardError Tag)
getUserSecretRssKey =
  (TextResult -> Tag)
-> Either PinboardError TextResult -> Either PinboardError Tag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextResult -> Tag
fromTextResult (Either PinboardError TextResult -> Either PinboardError Tag)
-> m (Either PinboardError TextResult)
-> m (Either PinboardError Tag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PinboardRequest -> m (Either PinboardError TextResult)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (ResultFormatType -> PinboardRequest
getUserSecretRssKeyRequest ResultFormatType
FormatJson)

-- | user/api_token : Returns the user's API token (for making API calls without a password)
getUserApiToken
  :: MonadPinboard m
  => m (Either PinboardError Text)
getUserApiToken :: m (Either PinboardError Tag)
getUserApiToken =
  (TextResult -> Tag)
-> Either PinboardError TextResult -> Either PinboardError Tag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextResult -> Tag
fromTextResult (Either PinboardError TextResult -> Either PinboardError Tag)
-> m (Either PinboardError TextResult)
-> m (Either PinboardError Tag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PinboardRequest -> m (Either PinboardError TextResult)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (ResultFormatType -> PinboardRequest
getUserApiTokenRequest ResultFormatType
FormatJson)

-- NOTES ---------------------------------------------------------------------
-- | notes/list : Returns a list of the user's notes (note text detail is not included)
getNoteList
  :: MonadPinboard m
  => m (Either PinboardError NoteList)
getNoteList :: m (Either PinboardError NoteList)
getNoteList = PinboardRequest -> m (Either PinboardError NoteList)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (ResultFormatType -> PinboardRequest
getNoteListRequest ResultFormatType
FormatJson)

-- | notes/id : Returns an individual user note. The hash property is a 20 character long sha1 hash of the note text.
getNote
  :: MonadPinboard m
  => NoteId -> m (Either PinboardError Note)
getNote :: Tag -> m (Either PinboardError Note)
getNote Tag
noteid = PinboardRequest -> m (Either PinboardError Note)
forall (m :: * -> *) a.
(MonadPinboard m, FromJSON a) =>
PinboardRequest -> m (Either PinboardError a)
pinboardJson (ResultFormatType -> Tag -> PinboardRequest
getNoteRequest ResultFormatType
FormatJson Tag
noteid)