Browse Source

add option to delay between requests (requestDelayMills)

master
Jon Schoning 5 years ago
parent
commit
7efe5940e8
  1. 4
      changelog.md
  2. 2
      pinboard.cabal
  3. 7
      src/Pinboard/Client.hs
  4. 1
      src/Pinboard/Types.hs
  5. 2
      src/Pinboard/Util.hs
  6. 7
      stack-8.0.yaml
  7. 7
      stack.yaml

4
changelog.md

@ -1,3 +1,7 @@
__v0.9.11__
add option to delay between requests (requestDelayMills)
__v0.9.10__
avoid pre-lifting IO into MonadIO

2
pinboard.cabal

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

7
src/Pinboard/Client.hs

@ -66,6 +66,7 @@ import Network.HTTP.Types.Status (statusCode)
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Control.Concurrent (threadDelay)
import Pinboard.Types as X
import Pinboard.Error as X
@ -81,7 +82,7 @@ import Prelude
-- | Create a default PinboardConfig using the supplied apiToken
fromApiToken :: String -> PinboardConfig
fromApiToken token = PinboardConfig { apiToken = pack token }
fromApiToken token = PinboardConfig { apiToken = pack token, requestDelayMills = 0 }
--------------------------------------------------------------------------------
-- | Execute computations in the Pinboard monad
@ -142,6 +143,8 @@ sendPinboardRequest (PinboardConfig{..}, mgr) PinboardRequest{..} = do
, "?"
, T.decodeUtf8 $ paramsToByteString $ ("auth_token", urlEncode False apiToken) : encodeParams requestParams ]
req <- buildReq $ T.unpack url
when (requestDelayMills > 0) $
threadDelay (requestDelayMills*1000)
httpLbs req mgr
--------------------------------------------------------------------------------
@ -150,7 +153,7 @@ buildReq :: String -> IO Request
buildReq url = do
req <- parseRequest $ "https://api.pinboard.in/v1/" <> url
return $ setRequestIgnoreStatus $ req {
requestHeaders = [("User-Agent","pinboard.hs/0.9.10")]
requestHeaders = [("User-Agent","pinboard.hs/0.9.11")]
}
--------------------------------------------------------------------------------

1
src/Pinboard/Types.hs

@ -72,6 +72,7 @@ data PinboardRequest = PinboardRequest
------------------------------------------------------------------------------
data PinboardConfig = PinboardConfig
{ apiToken :: !ByteString
, requestDelayMills :: !Int
} deriving Show
------------------------------------------------------------------------------

2
src/Pinboard/Util.hs

@ -32,7 +32,7 @@ import Prelude
------------------------------------------------------------------------------
mkConfig :: PinboardConfig
mkConfig = PinboardConfig { apiToken = mempty }
mkConfig = PinboardConfig { apiToken = mempty, requestDelayMills = 0 }
------------------------------------------------------------------------------
-- | Conversion from a `Show` constrained type to `Text`

7
stack-8.0.yaml

@ -1,6 +1,7 @@
flags: {}
packages:
- '.'
extra-package-dbs: []
packages:
- '.'
extra-deps: []
resolver: nightly-2016-09-20
resolver: nightly-2016-10-29

7
stack.yaml

@ -1,6 +1,7 @@
flags: {}
packages:
- '.'
extra-package-dbs: []
packages:
- '.'
extra-deps: []
resolver: nightly-2016-09-20
resolver: nightly-2016-10-29

Loading…
Cancel
Save