pinboard 0.9.9 → 0.9.10
raw patch · 4 files changed
+34/−29 lines, 4 filesdep ~aeson
Dependency ranges changed: aeson
Files
- changelog.md +10/−0
- pinboard.cabal +2/−2
- src/Pinboard/Client.hs +17/−19
- tests/Test.hs +5/−8
changelog.md view
@@ -1,3 +1,13 @@+__v0.9.10__++avoid pre-lifting IO into MonadIO++extend aeson upper-bound++__v0.9.9__++generalize (Either PinboardError a) to (MonadErrorPinboard)+ __v0.9.8__ use safe-exception
pinboard.cabal view
@@ -1,5 +1,5 @@ name: pinboard-version: 0.9.9+version: 0.9.10 synopsis: Access to the Pinboard API license: MIT license-file: LICENSE@@ -23,7 +23,7 @@ library hs-source-dirs: src build-depends: base >=4.6 && < 5.0- , aeson >= 0.11.1 && <0.12+ , aeson >= 0.11.1 && < 2.0 , bytestring >= 0.10.0 && <0.11 , containers >= 0.5.0.0 && <0.6 , either >= 4.4.1 && < 4.5
src/Pinboard/Client.hs view
@@ -91,7 +91,7 @@ -> PinboardT m a -> m (e a) runPinboard config f = do- mgr <- newMgr+ mgr <- liftIO newMgr eitherToMonadError <$> runPinboardT (config, mgr) f @@ -102,57 +102,55 @@ -> m a pinboardJson req = do env <- ask- res <- sendPinboardRequest env (ensureResultFormatType FormatJson req)+ res <- liftIO $ sendPinboardRequest env (ensureResultFormatType FormatJson req) eitherToMonadThrow (parseJSONResponse res) -------------------------------------------------------------------------------- runPinboardSingleRaw- :: MonadIO m- => PinboardConfig + :: PinboardConfig -> PinboardRequest- -> m (Response LBS.ByteString)+ -> IO (Response LBS.ByteString) runPinboardSingleRaw config req = liftIO $ newMgr >>= go where go mgr = sendPinboardRequest (config, mgr) req runPinboardSingleRawBS- :: (MonadIO m, MonadErrorPinboard e)+ :: (MonadErrorPinboard e) => PinboardConfig -> PinboardRequest- -> m (e LBS.ByteString)+ -> IO (e LBS.ByteString) runPinboardSingleRawBS config req = do res <- runPinboardSingleRaw config req return $ responseBody res <$ checkStatusCodeResponse res runPinboardSingleJson- :: (MonadIO m, MonadCatch m, MonadErrorPinboard e, FromJSON a)+ :: (MonadErrorPinboard e, FromJSON a) => PinboardConfig -> PinboardRequest- -> m (e a)+ -> IO (e a) runPinboardSingleJson config = runPinboard config . pinboardJson -------------------------------------------------------------------------------- sendPinboardRequest- :: MonadIO m- => PinboardEnv+ :: PinboardEnv -> PinboardRequest - -> m (Response LBS.ByteString)+ -> IO (Response LBS.ByteString) sendPinboardRequest (PinboardConfig{..}, mgr) PinboardRequest{..} = do let url = T.concat [ requestPath , "?" , T.decodeUtf8 $ paramsToByteString $ ("auth_token", urlEncode False apiToken) : encodeParams requestParams ] req <- buildReq $ T.unpack url- liftIO $ httpLbs req mgr+ httpLbs req mgr -------------------------------------------------------------------------------- -buildReq :: MonadIO m => String -> m Request+buildReq :: String -> IO Request buildReq url = do- req <- liftIO $ parseRequest $ "https://api.pinboard.in/v1/" <> url+ req <- parseRequest $ "https://api.pinboard.in/v1/" <> url return $ setRequestIgnoreStatus $ req { - requestHeaders = [("User-Agent","pinboard.hs/0.9.9")]+ requestHeaders = [("User-Agent","pinboard.hs/0.9.10")] } --------------------------------------------------------------------------------@@ -210,9 +208,9 @@ -------------------------------------------------------------------------------- -newMgr :: MonadIO m => m Manager-newMgr = liftIO $ withSocketsDo . newManager - $ managerSetProxy (proxyEnvironment Nothing) tlsManagerSettings+newMgr :: IO Manager+newMgr = withSocketsDo . newManager + $ managerSetProxy (proxyEnvironment Nothing) tlsManagerSettings mgrFail :: (Monad m, MonadErrorPinboard e) => PinboardErrorType -> SomeException -> m (e b) mgrFail e msg = return $ throwError $ PinboardError e (toText msg) Nothing Nothing Nothing
tests/Test.hs view
@@ -31,26 +31,23 @@ propJSONApproxEq (Proxy :: Proxy PostDates) describe "decodeJSONResponse: handle parse failures" $ do- it "object parse failure" $+ it "malformed object parses as ParseFailure" $ let noteJson = "FAIL" in case decodeJSONResponse noteJson of Left PinboardError{..} -> errorType == ParseFailure Right Note{..} -> False- it "field parse failure" $+ it "malformed field parses as ParseFailure" $ let noteJson = "{\"length\":0,\"hash\":\"\",\"text_FAIL\":\"\",\"updated_at\":\"1864-05-09 13:50:53\",\"created_at\":\"1864-05-09 18:21:35\",\"id\":\"\",\"title\":\"\"}" in case decodeJSONResponse noteJson of Left PinboardError{..} -> errorType == ParseFailure Right Note{..} -> False- it "value parse failure" $- let noteJson = "{\"length\":FAIL,\"hash\":\"\",\"text_FAIL\":\"\",\"updated_at\":\"1864-05-09 13:50:53\",\"created_at\":\"1864-05-09 18:21:35\",\"id\":\"\",\"title\":\"\"}"+ it "malformed value parses as ParseFailure" $+ let noteJson = "{\"length\":FAIL,\"hash\":\"\",\"text\":\"\",\"updated_at\":\"1864-05-09 13:50:53\",\"created_at\":\"1864-05-09 18:21:35\",\"id\":\"\",\"title\":\"\"}" in case decodeJSONResponse noteJson of Left PinboardError{..} -> errorType == ParseFailure Right Note{..} -> False- it "time parse failure" $+ it "malformed time parses as ParseFailure" $ let noteJson = "{\"length\":0,\"hash\":\"\",\"text\":\"\",\"updated_at\":\"FAIL-05-09 13:50:53\",\"created_at\":\"1864-05-09 18:21:35\",\"id\":\"\",\"title\":\"\"}" in case decodeJSONResponse noteJson of Left PinboardError{..} -> errorType == ParseFailure Right Note{..} -> False--pinboardParseFailure :: Selector PinboardError-pinboardParseFailure e = errorType e == ParseFailure