Browse Source

catch pinboarderrors

master
Jon Schoning 5 years ago
parent
commit
fd6f5bb9c2
  1. 2
      samples/sample.hs
  2. 10
      src/Pinboard/Client.hs
  3. 2
      src/Pinboard/Types.hs
  4. 1
      stack-7.10.yaml
  5. 2
      stack.yaml

2
samples/sample.hs

@ -8,4 +8,4 @@ main = do
result <- runPinboard config $ getPostsRecent Nothing Nothing
case result of
Right details -> print details
Left pinboardError -> print pinboardError
Left pinboardError -> print ("L: " ++ show pinboardError)

10
src/Pinboard/Client.hs

@ -1,3 +1,4 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
@ -51,8 +52,6 @@ import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Exception.Safe
import Control.Monad.Error.Class (throwError)
import Data.ByteString.Char8 (pack)
import Data.Monoid ((<>))
@ -86,12 +85,13 @@ fromApiToken token = PinboardConfig { apiToken = pack token }
--------------------------------------------------------------------------------
-- | Execute computations in the Pinboard monad
runPinboard
:: MonadIO m
:: (MonadIO m, MonadCatch m)
=> PinboardConfig
-> PinboardT m a
-> m (Either PinboardError a)
runPinboard config f = newMgr >>= go
runPinboard config f = newMgr >>= go
where go mgr = runPinboardT (config, mgr) f
`catch` \(e::PinboardError) -> return (Left e)
-- | Create a Pinboard value from a PinboardRequest w/ json deserialization
@ -102,7 +102,7 @@ pinboardJson
pinboardJson req = do
env <- ask
res <- sendPinboardRequest env (ensureResultFormatType FormatJson req)
either throwError return (parseJSONResponse res)
either throw return (parseJSONResponse res)
--------------------------------------------------------------------------------

2
src/Pinboard/Types.hs

@ -33,7 +33,6 @@ import Data.Time.Clock(UTCTime)
import Network.HTTP.Client (Manager)
import Pinboard.Error (PinboardError (..))
import Control.Monad.Error.Class (MonadError)
import Control.Applicative
import Control.Exception.Safe
@ -61,7 +60,6 @@ type MonadPinboard m =
, MonadReader PinboardEnv m
, MonadThrow m
, MonadCatch m
, MonadError PinboardError m
)
------------------------------------------------------------------------------

1
stack-7.10.yaml

@ -4,4 +4,5 @@ packages:
extra-deps:
- http-client-0.5.0
- http-client-tls-0.3.0
- safe-exceptions-0.1.4.0
resolver: lts-6.6

2
stack.yaml

@ -4,5 +4,5 @@ packages:
extra-deps:
- http-client-0.5.0
- http-client-tls-0.3.0
resolver: nightly-2016-07-15
resolver: nightly-2016-08-06

Loading…
Cancel
Save