pinboard 0.7.5 → 0.8.5

raw patch · 4 files changed

+106/−71 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• pinboard.cabal +1/−1
• src/Pinboard/Api.hs +45/−29
• src/Pinboard/Client.hs +43/−38
• src/Pinboard/Client/Types.hs +17/−3

@@ -1,5 +1,5 @@ name:                pinboard-version:             0.7.5+version:             0.8.5 synopsis:            Access to the Pinboard API license:             MIT license-file:        LICENSE

@@ -1,5 +1,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}  ------------------------------------------- -- |@@ -38,10 +40,9 @@     ) where  import Pinboard.Client          (pinboardJson)-import Pinboard.Client.Types    (Pinboard) import Data.Text                (Text) import Data.Time                (UTCTime)-import Pinboard.Client.Types    (ResultFormatType (..))+import Pinboard.Client.Types    (MonadPinboard, ResultFormatType (..)) import Pinboard.ApiTypes         import Pinboard.ApiRequest @@ -52,59 +53,66 @@  -- | posts/recent : Returns a list of the user's most recent posts, filtered by tag. getPostsRecent-  :: Maybe [Tag] -- ^ filter by up to three tags+  :: MonadPinboard m+  => Maybe [Tag] -- ^ filter by up to three tags   -> Maybe Count -- ^ number of results to return. Default is 15, max is 100  -  -> Pinboard Posts+  -> m Posts getPostsRecent tags count = pinboardJson $ getPostsRecentRequest FormatJson tags count  -- | posts/all : Returns all bookmarks in the user's account. getPostsAll-  :: Maybe [Tag] -- ^ filter by up to three tags+  :: 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-  -> Pinboard [Post]+  -> m [Post] getPostsAll tags start results fromdt todt meta = pinboardJson $ getPostsAllRequest FormatJson 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. getPostsForDate-  :: Maybe [Tag] -- ^ filter by up to three tags+  :: 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-  -> Pinboard Posts+  -> m Posts getPostsForDate tags date url = pinboardJson $ getPostsForDateRequest FormatJson 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+  :: MonadPinboard m+  => Maybe [Tag] -- ^ filter by up to three tags+  -> m PostDates getPostsDates tags = pinboardJson $ getPostsDatesRequest FormatJson tags   -- | posts/update : Returns the most recent time a bookmark was added, updated or deleted.-getPostsMRUTime :: Pinboard UTCTime+getPostsMRUTime :: MonadPinboard m => m UTCTime getPostsMRUTime = fromUpdateTime <$> pinboardJson (getPostsMRUTimeRequest 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-  :: Url-  -> Pinboard [Suggested]+  :: MonadPinboard m+  => Url+  -> m [Suggested] getSuggestedTags url = pinboardJson $ getSuggestedTagsRequest FormatJson url  -- | posts/delete : Delete an existing bookmark. deletePost -  :: Url-  -> Pinboard ()+  :: MonadPinboard m+  => Url+  -> m () deletePost url = fromDoneResult <$> (pinboardJson $ deletePostRequest FormatJson url)  -- | posts/add : Add or Update a bookmark addPost-  :: Url            -- ^ the URL of the item+  :: 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@@ -112,14 +120,15 @@   -> 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"-  -> Pinboard ()+  -> m () addPost url descr ext tags ctime repl shared toread = fromDoneResult <$> (pinboardJson $ addPostRequest FormatJson url descr ext tags ctime repl shared toread)  -- | posts/add :  Add or Update a bookmark, from a Post record addPostRec-  :: Post         -- ^ a Post record+  :: MonadPinboard m+  => Post         -- ^ a Post record   -> Replace      -- ^ Replace any existing bookmark with the Posts URL. If set to no, will fail if bookmark exists -  -> Pinboard ()+  -> m () addPostRec post replace = fromDoneResult <$> (pinboardJson $ addPostRecRequest FormatJson post replace)  -- TAGS ----------------------------------------------------------------------@@ -128,22 +137,25 @@ -- | tags/get : Returns a full list of the user's tags along with the number of  -- times they were used. getTags -  :: Pinboard TagMap+  :: MonadPinboard m+  => m TagMap getTags = fromJsonTagMap <$> (pinboardJson $ getTagsRequest FormatJson )   -- | tags/delete : Delete an existing tag. deleteTag -  :: Tag -  -> Pinboard ()+  :: MonadPinboard m+  => Tag +  -> m () deleteTag tag = fromDoneResult <$> (pinboardJson $ deleteTagRequest FormatJson tag)   -- | tags/rename : Rename an tag, or fold it in to an existing tag renameTag -  :: Old -- ^ note: match is not case sensitive+  :: MonadPinboard m+  => Old -- ^ note: match is not case sensitive   -> New -- ^ if empty, nothing will happen-  -> Pinboard ()+  -> m () renameTag old new = fromDoneResult <$> (pinboardJson $ renameTagRequest FormatJson old new)  @@ -151,12 +163,14 @@  -- | user/secret : Returns the user's secret RSS key (for viewing private feeds) getUserSecretRssKey -  :: Pinboard Text+  :: MonadPinboard m+  => m Text getUserSecretRssKey = fromTextResult <$> (pinboardJson $ getUserSecretRssKeyRequest FormatJson )  -- | user/api_token : Returns the user's API token (for making API calls without a password) getUserApiToken -  :: Pinboard Text+  :: MonadPinboard m+  => m Text getUserApiToken = fromTextResult <$> (pinboardJson $ getUserApiTokenRequest FormatJson )  @@ -164,12 +178,14 @@  -- | notes/list : Returns a list of the user's notes (note text detail is not included) getNoteList -  :: Pinboard NoteList+  :: MonadPinboard m+  => m NoteList getNoteList = pinboardJson $ getNoteListRequest FormatJson   -- | 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+  :: MonadPinboard m+  => NoteId+  -> m Note getNote noteid = pinboardJson $ getNoteRequest FormatJson noteid 

@@ -2,6 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}  ------------------------------------------------------------------------------ -- | @@ -49,13 +51,15 @@   import Control.Exception          (catch, SomeException, try, bracket)-import Control.Monad.IO.Class     (MonadIO (liftIO))-import Control.Monad.Reader       (ask, runReaderT)-import Control.Monad.Trans.Either (runEitherT, hoistEither)+import Control.Monad.IO.Class+import Control.Monad.Reader+import Control.Monad.Except+ import Data.ByteString.Char8      (pack) import Data.Monoid                ((<>)) import Data.Aeson                 (FromJSON, eitherDecodeStrict') + import Network                    (withSocketsDo) import Network.HTTP.Types         (urlEncode) import Network.HTTP.Types.Status  (statusCode)@@ -83,38 +87,38 @@ -------------------------------------------------------------------------------- -- | Execute computations in the Pinboard monad runPinboard-    :: PinboardConfig-    -> Pinboard a-    -> IO (Either PinboardError a)-runPinboard config requests = -  bracket mgrOpen return (either (mgrFail ConnectionFailure) go)-  where go mgr = runReaderT (runEitherT requests) (config, mgr) -                  `catch` mgrFail UnknownErrorType+    :: MonadIO m+    => PinboardConfig+    -> PinboardT m a+    -> m (Either PinboardError a)+runPinboard config requests = mgrOpenRaw >>= go+  where go mgr = runExceptT $ runReaderT requests (config, mgr)   -- | Create a Pinboard value from a PinboardRequest w/ json deserialization-pinboardJson :: FromJSON a => PinboardRequest -> Pinboard a+pinboardJson :: (MonadPinboard m, FromJSON a) => PinboardRequest -> m a pinboardJson req = do    (config, mgr)  <- ask-  result <- liftIO $ sendPinboardRequest (ensureResultFormatType FormatJson req) config mgr parseJSONResponse-  hoistEither result-+  res <- sendPinboardRequest (ensureResultFormatType FormatJson req) config mgr parseJSONResponse+  res  --------------------------------------------------------------------------------  runPinboardSingleRaw-    :: PinboardConfig       +    :: MonadIO m+    => PinboardConfig            -> PinboardRequest     -> (Response LBS.ByteString -> a)-    -> IO (Either PinboardError a)+    -> m (Either PinboardError a) runPinboardSingleRaw config req handler = -  bracket mgrOpen return (either (mgrFail ConnectionFailure) go)+  liftIO $ bracket mgrOpen return (either (mgrFail ConnectionFailure) go)     where go mgr = (Right <$> sendPinboardRequest req config mgr handler)                     `catch` mgrFail UnknownErrorType  runPinboardSingleRawBS-    :: PinboardConfig       +    :: MonadIO m+    => PinboardConfig            -> PinboardRequest-    -> IO (Either PinboardError LBS.ByteString)+    -> m (Either PinboardError LBS.ByteString) runPinboardSingleRawBS config req = do   res <- runPinboardSingleRaw config req id   return $ do@@ -122,58 +126,59 @@     responseBody r <$ checkStatusCodeResponse r  runPinboardSingleJson-    :: FromJSON a+    :: (MonadIO m, FromJSON a)     => PinboardConfig            -> PinboardRequest-    -> IO (Either PinboardError a)+    -> m (Either PinboardError a) runPinboardSingleJson config = runPinboard config . pinboardJson   --------------------------------------------------------------------------------  sendPinboardRequest-      :: PinboardRequest +      :: MonadIO m+      => PinboardRequest        -> PinboardConfig        -> Manager       -> (Response LBS.ByteString -> a)-      -> IO a+      -> m a sendPinboardRequest PinboardRequest{..} PinboardConfig{..} man handler = do    let url = T.concat [ requestPath                        , "?"                        , T.decodeUtf8 $ paramsToByteString $ ("auth_token", urlEncode False apiToken) : encodeParams requestParams ]    req <- buildReq $ T.unpack url-   res <- httpLbs req man+   res <- liftIO $ httpLbs req man    return $ handler res  -------------------------------------------------------------------------------- -buildReq ::  String -> IO Request+buildReq :: MonadIO m => String -> m Request buildReq url = do-  req <- parseUrl $ "https://api.pinboard.in/v1/" <> url+  req <- liftIO $ parseUrl $ "https://api.pinboard.in/v1/" <> url   return $ req -    { requestHeaders = [("User-Agent","pinboard.hs/0.7.5")]+    { requestHeaders = [("User-Agent","pinboard.hs/0.8.5")]     , checkStatus = \_ _ _ -> Nothing     }  --------------------------------------------------------------------------------  parseJSONResponse-    :: (FromJSON a)+    :: (MonadError PinboardError m, FromJSON a)     => Response LBS.ByteString-    -> Either PinboardError a+    -> m a parseJSONResponse response = -  either (Left . addErrMsg (toText (responseBody response))) +  either (throwError . addErrMsg (toText (responseBody response)))           (const $ decodeJSONResponse (responseBody response))           (checkStatusCodeResponse response)   decodeJSONResponse-    :: FromJSON a +    :: (MonadError PinboardError m, FromJSON a)      => LBS.ByteString -    -> Either PinboardError a+    -> m a decodeJSONResponse s =    let r = eitherDecodeStrict' (LBS.toStrict s) -  in either (Left . createParserErr . toText) Right r+  in either (throwError . createParserErr . toText) (return . id) r  -------------------------------------------------------------------------------- @@ -208,14 +213,14 @@ --------------------------------------------------------------------------------  -mgrOpenRaw :: IO Manager-mgrOpenRaw = withSocketsDo . newManager +mgrOpenRaw :: MonadIO m => m Manager+mgrOpenRaw = liftIO $ withSocketsDo . newManager                  $ managerSetProxy (proxyEnvironment Nothing) tlsManagerSettings -mgrOpen :: IO (Either SomeException Manager)-mgrOpen = try mgrOpenRaw+mgrOpen :: MonadIO m => m (Either SomeException Manager)+mgrOpen = liftIO $ try mgrOpenRaw -mgrFail :: PinboardErrorType -> SomeException -> IO (Either PinboardError b)+mgrFail :: MonadIO m => PinboardErrorType -> SomeException -> m (Either PinboardError b) mgrFail e msg = return $ Left $ PinboardError e (toText msg) Nothing Nothing Nothing  

@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE OverloadedStrings #-}  -- |@@ -7,7 +9,8 @@ -- Stability   : experimental -- Portability : POSIX module Pinboard.Client.Types-  ( Pinboard+  ( PinboardT+  , MonadPinboard   , PinboardRequest (..)   , PinboardConfig  (..)   , ResultFormatType (..)@@ -16,17 +19,28 @@   ) where  import Control.Monad.Reader       (ReaderT)-import Control.Monad.Trans.Either (EitherT) import Data.ByteString            (ByteString) import Data.Text                  (Text) import Network.HTTP.Client        (Manager) import Pinboard.Client.Error  (PinboardError (..)) import Data.Time.Calendar(Day) import Data.Time.Clock(UTCTime)+import Control.Monad.Reader.Class(MonadReader)+import Control.Monad.Error.Class(MonadError)+import Control.Monad.IO.Class(MonadIO)+import Control.Monad.Except(ExceptT)  ------------------------------------------------------------------------------ -type Pinboard = EitherT PinboardError (ReaderT (PinboardConfig, Manager) IO)+type PinboardT m a = ReaderT (PinboardConfig, Manager) (ExceptT PinboardError m) a++-- |Typeclass alias for the return type of the API functions (keeps the+-- signatures less verbose)+type MonadPinboard m =+  ( MonadIO m+  , MonadReader (PinboardConfig, Manager) m+  , MonadError PinboardError m+  )  ------------------------------------------------------------------------------