pinboard 0.9.12.11 → 0.10.0.0

raw patch · 7 files changed

+78/−125 lines, 7 filesdep +unliftiodep +unliftio-coredep −safe-exceptionsPVP ok

version bump matches the API change (PVP)

Dependencies added: unliftio, unliftio-core

Dependencies removed: safe-exceptions

API changes (from Hackage documentation)

Files

• changelog.md +6/−0
• pinboard.cabal +6/−4
• src/Pinboard/Api.hs +26/−25
• src/Pinboard/Client.hs +27/−30
• src/Pinboard/Error.hs +3/−51
• src/Pinboard/Logging.hs +4/−5
• src/Pinboard/Types.hs +6/−10

@@ -1,3 +1,9 @@+__v0.10.0.0++refactor; use UnliftIO; remove MonadError/MonadErrorPinboard; remove ExceptT from PinboardT++** previously caught http exceptions may no longer by automatically be caught - need to test further **+ __v0.9.12.11  update deps bounds

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 1673165f708104f1e817541e1b6f9c564bdecacc585826d2a67884ce5f1073b8+-- hash: a128fdac0398efc5e98857801cf3fd9898c22a2f68dcc4c33c1f8ef86bf671e9  name:           pinboard-version:        0.9.12.11+version:        0.10.0.0 synopsis:       Access to the Pinboard API description:    .                 The Pinboard API is a way to interact programatically with@@ -47,10 +47,11 @@     , network >=2.6.2 && <2.8     , profunctors >=5     , random >=1.1-    , safe-exceptions <0.2     , text >=0.11 && <1.3     , time >=1.5 && <1.9     , transformers >=0.4.0.0+    , unliftio+    , unliftio-core     , unordered-containers     , vector >=0.10.9 && <0.13   exposed-modules:@@ -83,11 +84,12 @@     , hspec >=1.8     , mtl >=2.2.1     , pinboard-    , safe-exceptions <0.2     , semigroups     , text     , time     , transformers >=0.4.0.0+    , unliftio+    , unliftio-core     , unordered-containers   other-modules:       ApproxEq

@@ -44,6 +44,7 @@ import Pinboard.Types (MonadPinboard, ResultFormatType(..)) import Pinboard.ApiTypes import Pinboard.ApiRequest+import Pinboard.Error  import Control.Applicative import Prelude@@ -54,7 +55,7 @@   :: MonadPinboard m   => Maybe [Tag] -- ^ filter by up to three tags   -> Maybe Count -- ^ number of results to return. Default is 15, max is 100  -  -> m Posts+  -> m (Either PinboardError Posts) getPostsRecent tags count =   pinboardJson $ getPostsRecentRequest FormatJson tags count @@ -67,7 +68,7 @@   -> 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 [Post]+  -> m (Either PinboardError [Post]) getPostsAll tags start results fromdt todt meta =   pinboardJson $ getPostsAllRequest FormatJson tags start results fromdt todt meta @@ -78,7 +79,7 @@   => Maybe [Tag] -- ^ filter by up to three tags   -> Maybe Date -- ^ return results bookmarked on this day   -> Maybe Url -- ^ return bookmark for this URL-  -> m Posts+  -> m (Either PinboardError Posts) getPostsForDate tags date url =   pinboardJson $ getPostsForDateRequest FormatJson tags date url @@ -86,30 +87,30 @@ getPostsDates   :: MonadPinboard m   => Maybe [Tag] -- ^ filter by up to three tags-  -> m PostDates+  -> m (Either PinboardError PostDates) getPostsDates tags = pinboardJson $ getPostsDatesRequest FormatJson tags  -- | posts/update : Returns the most recent time a bookmark was added, updated or deleted. getPostsMRUTime   :: MonadPinboard m-  => m UTCTime+  => m (Either PinboardError UTCTime) getPostsMRUTime =-  fromUpdateTime <$> pinboardJson (getPostsMRUTimeRequest FormatJson)+  fmap 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   :: MonadPinboard m-  => Url -> m [Suggested]+  => Url -> m (Either PinboardError [Suggested]) getSuggestedTags url = pinboardJson $ getSuggestedTagsRequest FormatJson url  -- | posts/delete : Delete an existing bookmark. deletePost   :: MonadPinboard m-  => Url -> m ()+  => Url -> m (Either PinboardError ()) deletePost url =-  fromDoneResult <$> pinboardJson (deletePostRequest FormatJson url)+  fmap fromDoneResult <$> pinboardJson (deletePostRequest FormatJson url)  -- | posts/add : Add or Update a bookmark addPost@@ -122,9 +123,9 @@   -> 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 ()+  -> m (Either PinboardError ()) addPost url descr ext tags ctime repl shared toread =-  fromDoneResult <$>+  fmap fromDoneResult <$>   pinboardJson     (addPostRequest FormatJson url descr ext tags ctime repl shared toread) @@ -133,58 +134,58 @@   :: 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 ()+  -> m (Either PinboardError ()) addPostRec post replace =-  fromDoneResult <$> pinboardJson (addPostRecRequest FormatJson post replace)+  fmap fromDoneResult <$> pinboardJson (addPostRecRequest FormatJson post 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 TagMap-getTags = fromJsonTagMap <$> pinboardJson (getTagsRequest FormatJson)+  => m (Either PinboardError TagMap)+getTags = fmap fromJsonTagMap <$> pinboardJson (getTagsRequest FormatJson)  -- | tags/delete : Delete an existing tag. deleteTag   :: MonadPinboard m-  => Tag -> m ()+  => Tag -> m (Either PinboardError ()) deleteTag tag =-  fromDoneResult <$> pinboardJson (deleteTagRequest FormatJson tag)+  fmap fromDoneResult <$> pinboardJson (deleteTagRequest FormatJson 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 ()+  -> m (Either PinboardError ()) renameTag old new =-  fromDoneResult <$> pinboardJson (renameTagRequest FormatJson old new)+  fmap fromDoneResult <$> pinboardJson (renameTagRequest FormatJson old new)  -- USER ---------------------------------------------------------------------- -- | user/secret : Returns the user's secret RSS key (for viewing private feeds) getUserSecretRssKey   :: MonadPinboard m-  => m Text+  => m (Either PinboardError Text) getUserSecretRssKey =-  fromTextResult <$> pinboardJson (getUserSecretRssKeyRequest FormatJson)+  fmap fromTextResult <$> pinboardJson (getUserSecretRssKeyRequest FormatJson)  -- | user/api_token : Returns the user's API token (for making API calls without a password) getUserApiToken   :: MonadPinboard m-  => m Text+  => m (Either PinboardError Text) getUserApiToken =-  fromTextResult <$> pinboardJson (getUserApiTokenRequest FormatJson)+  fmap fromTextResult <$> pinboardJson (getUserApiTokenRequest FormatJson)  -- NOTES --------------------------------------------------------------------- -- | notes/list : Returns a list of the user's notes (note text detail is not included) getNoteList   :: MonadPinboard m-  => m NoteList+  => m (Either PinboardError 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   :: MonadPinboard m-  => NoteId -> m Note+  => NoteId -> m (Either PinboardError Note) getNote noteid = pinboardJson $ getNoteRequest FormatJson noteid

@@ -53,8 +53,8 @@ import Control.Monad.IO.Class import Control.Monad.Reader -import Control.Exception.Safe-import Control.Monad.Error.Class+import Control.Monad.IO.Unlift+import UnliftIO.Exception  import Data.ByteString.Char8 (pack) import Data.Monoid ((<>))@@ -113,21 +113,21 @@ -------------------------------------------------------------------------------- -- | Execute computations in the Pinboard monad runPinboard-  :: (MonadIO m, MonadCatch m, MonadErrorPinboard e)-  => PinboardConfig -> PinboardT m a -> m (e a)+  :: MonadUnliftIO m+  => PinboardConfig -> PinboardT m a -> m a runPinboard config f = liftIO newMgr >>= \mgr -> runPinboardE (config, mgr) f  -- | Execute computations in the Pinboard monad (with specified http Manager) runPinboardE-  :: (MonadIO m, MonadCatch m, MonadErrorPinboard e)-  => PinboardEnv -> PinboardT m a -> m (e a)+  :: MonadUnliftIO m+  => PinboardEnv -> PinboardT m a -> m a runPinboardE (config, mgr) f =-  eitherToMonadError <$> runPinboardT (config, mgr) f+  runPinboardT (config, mgr) f  -- | Create a Pinboard value from a PinboardRequest w/ json deserialization pinboardJson   :: (MonadPinboard m, FromJSON a)-  => PinboardRequest -> m a+  => PinboardRequest -> m (Either PinboardError a) pinboardJson req =   logOnException logSrc $   do logNST LevelInfo logSrc (toText req)@@ -135,7 +135,7 @@      res <-        liftIO $ sendPinboardRequest env (ensureResultFormatType FormatJson req)      logNST LevelDebug logSrc (toText res)-     eitherToMonadThrow (parseJSONResponse res)+     pure (parseJSONResponse res)   where     logSrc = "pinboardJson" @@ -154,8 +154,8 @@     logSrc = "runPinboardSingleRaw"  runPinboardSingleRawBS-  :: (MonadErrorPinboard e)-  => PinboardConfig -> PinboardRequest -> IO (e LBS.ByteString)+  :: +  PinboardConfig -> PinboardRequest -> IO (Either PinboardError LBS.ByteString) runPinboardSingleRawBS config req = do   res <- runPinboardSingleRaw config req   case checkStatusCodeResponse res of@@ -166,11 +166,11 @@     logErrorAndThrow e =       runConfigLoggingT config $       do logNST LevelError logSrc (toText e)-         return (throwError e)+         return (Left e)  runPinboardSingleJson-  :: (MonadErrorPinboard e, FromJSON a)-  => PinboardConfig -> PinboardRequest -> IO (e a)+  :: FromJSON a+  => PinboardConfig -> PinboardRequest -> IO (Either PinboardError a) runPinboardSingleJson config = runPinboard config . pinboardJson  --------------------------------------------------------------------------------@@ -223,30 +223,28 @@  -------------------------------------------------------------------------------- parseJSONResponse-  :: (MonadErrorPinboard e, FromJSON a)-  => Response LBS.ByteString -> e a+  :: FromJSON a+  => Response LBS.ByteString -> Either PinboardError a parseJSONResponse response =   either-    (throwError . addErrMsg (toText (responseBody response)))+    (Left . addErrMsg (toText (responseBody response)))     (const $ decodeJSONResponse (responseBody response))     (checkStatusCodeResponse response)  decodeJSONResponse-  :: (MonadErrorPinboard e, FromJSON a)-  => LBS.ByteString -> e a+  :: FromJSON a+  => LBS.ByteString -> Either PinboardError a decodeJSONResponse s =   let r = eitherDecodeStrict' (LBS.toStrict s)-  in either (throwError . createParserErr . T.pack) return r+  in either (Left . createParserErr . T.pack) return r  -------------------------------------------------------------------------------- checkStatusCodeResponse-  :: MonadErrorPinboard e-  => Response a -> e ()+  :: Response a -> Either PinboardError () checkStatusCodeResponse = checkStatusCode . statusCode . responseStatus  checkStatusCode-  :: MonadErrorPinboard e-  => Int -> e ()+  :: Int -> Either PinboardError () checkStatusCode =   \case     200 -> return ()@@ -262,10 +260,9 @@  -------------------------------------------------------------------------------- httpStatusPinboardError-  :: MonadErrorPinboard e-  => PinboardErrorHTTPCode -> e a+  :: PinboardErrorHTTPCode -> Either PinboardError a httpStatusPinboardError err =-  throwError+  Left     defaultPinboardError     { errorType = HttpStatusFailure     , errorHTTP = Just err@@ -286,7 +283,7 @@   withSocketsDo . newManager $ managerSetProxy (proxyEnvironment Nothing) tlsManagerSettings  mgrFail-  :: (Monad m, MonadErrorPinboard e)-  => PinboardErrorType -> SomeException -> m (e b)+  :: (Monad m)+  => PinboardErrorType -> SomeException -> m (Either PinboardError b) mgrFail e msg =-  return $ throwError $ PinboardError e (toText msg) Nothing Nothing Nothing+  return $ Left $ PinboardError e (toText msg) Nothing Nothing Nothing

@@ -10,27 +10,19 @@ -- Stability   : experimental -- Portability : POSIX module Pinboard.Error-  ( MonadErrorPinboard-  , defaultPinboardError-  , pinboardExceptionToEither-  , pinboardExceptionToMonadError-  , exceptionToMonadErrorPinboard-  , tryMonadError-  , eitherToMonadError-  , eitherToMonadThrow+  ( defaultPinboardError   , PinboardErrorHTTPCode(..)   , PinboardErrorType(..)   , PinboardErrorCode(..)   , PinboardError(..)   ) where -import Data.Text (Text, pack)+import Data.Text (Text)  import Data.Monoid import Prelude -import Control.Exception.Safe-import Control.Monad.Error.Class (MonadError, throwError)+import UnliftIO  ------------------------------------------------------------------------------ data PinboardErrorHTTPCode@@ -68,45 +60,5 @@  instance Exception PinboardError -type MonadErrorPinboard m = MonadError PinboardError m- defaultPinboardError :: PinboardError defaultPinboardError = PinboardError UnknownErrorType mempty Nothing Nothing Nothing--pinboardExceptionToEither-  :: MonadCatch m-  => m (Either PinboardError a) -> m (Either PinboardError a)-pinboardExceptionToEither = handle (\(e :: PinboardError) -> return (Left e))--tryMonadError-  :: (Exception e, MonadCatch m, MonadError e r)-  => m a -> m (r a)-tryMonadError a = eitherToMonadError <$> try a--pinboardExceptionToMonadError-  :: (MonadCatch m, MonadErrorPinboard e)-  => m (e a) -> m (e a)-pinboardExceptionToMonadError =-  handle (\(e :: PinboardError) -> return (throwError e))--exceptionToMonadErrorPinboard-  :: (MonadCatch m, MonadErrorPinboard e)-  => m (e a) -> m (e a)-exceptionToMonadErrorPinboard =-  handle-    (\(e :: SomeException) ->-        return $-        throwError $-        defaultPinboardError-        { errorMsg = (pack . show) e-        })--eitherToMonadError-  :: MonadError e m-  => Either e a -> m a-eitherToMonadError = either throwError return--eitherToMonadThrow-  :: (Exception e, MonadThrow m)-  => Either e a -> m a-eitherToMonadThrow = either throw return

@@ -24,9 +24,8 @@  import Control.Monad.IO.Class import Control.Monad.Logger-import Control.Exception.Safe+import UnliftIO import Data.Time-import Data.Monoid  import Data.Text as T @@ -55,16 +54,16 @@ ------------------------------------------------------------------------------  logOnException-  :: (MonadLogger m, MonadCatch m, MonadIO m)+  :: (MonadLogger m, MonadUnliftIO m)   => T.Text -> m a -> m a logOnException src =   handle     (\(e :: SomeException) -> do        logNST LevelError src (toText e)-       throw e)+       throwIO e)  runLogOnException-  :: (MonadCatch m, MonadIO m)+  :: MonadUnliftIO m   => T.Text -> PinboardConfig -> LoggingT m a -> m a runLogOnException logSrc config = runConfigLoggingT config . logOnException logSrc 

@@ -25,42 +25,38 @@  import Control.Monad.Reader (ReaderT) import Control.Monad.Reader.Class (MonadReader)-import Control.Monad.Trans.Except (ExceptT, runExceptT) import Control.Monad.Trans.Reader (runReaderT) import Control.Monad.IO.Class (MonadIO) -import Control.Exception.Safe+import UnliftIO  import Data.ByteString (ByteString) import Data.Text (Text) import Data.Time.Calendar (Day) import Data.Time.Clock (UTCTime)-import Data.IORef import Network.HTTP.Client (Manager) -import Pinboard.Error import Control.Monad.Logger -import Control.Applicative import Prelude  ------------------------------------------------------------------------------ type PinboardEnv = (PinboardConfig, Manager) -type PinboardT m a = ReaderT PinboardEnv (ExceptT PinboardError (LoggingT m)) a+type PinboardT m a = ReaderT PinboardEnv (LoggingT m) a  runPinboardT-  :: (MonadIO m, MonadCatch m)-  => PinboardEnv -> PinboardT m a -> m (Either PinboardError a)+  :: MonadUnliftIO m+  => PinboardEnv -> PinboardT m a -> m a runPinboardT env@(config, _) f =   runConfigLoggingT     config-    (pinboardExceptionToEither (runExceptT (runReaderT f env)))+    (runReaderT f env)  ------------------------------------------------------------------------------ -- |Typeclass alias for the return type of the API functions (keeps the -- signatures less verbose)-type MonadPinboard m = (Functor m, Applicative m, MonadIO m, MonadCatch m, MonadReader PinboardEnv m, MonadLogger m)+type MonadPinboard m = (MonadUnliftIO m, MonadReader PinboardEnv m, MonadLogger m)  ------------------------------------------------------------------------------ type ExecLoggingT = forall m. MonadIO m =>