wreq-helper (empty) → 0.1.0.0
raw patch · 3 files changed
+169/−0 lines, 3 filesdep +aesondep +aeson-resultdep +base
Dependencies added: aeson, aeson-result, base, bytestring, http-client, lens, text, wreq
Files
- LICENSE +30/−0
- src/Network/Wreq/Helper.hs +108/−0
- wreq-helper.cabal +31/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Li Meng Jun (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Li Meng Jun nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ src/Network/Wreq/Helper.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Network.Wreq.Helper+ ( responseValue+ , responseMaybe+ , responseEither+ , responseEither'+ , responseEitherJSON+ , responseJSON+ , responseOk+ , responseOk_+ , responseList+ , responseList_+ , tryResponse+ , eitherToError+ ) where++import Control.Exception (try)+import Control.Lens ((^.), (^?))+import Data.Aeson (FromJSON (..), decode)+import Data.Aeson.Result (Err, List, Ok, err, throwError, toList,+ toOk)+import qualified Data.ByteString.Char8 as B (unpack)+import qualified Data.ByteString.Lazy as LB (ByteString, fromStrict)+import Data.Text (Text)+import Network.HTTP.Client (HttpException (..),+ HttpExceptionContent (..))+import Network.Wreq (Response, asJSON, responseBody)++eitherToError :: IO (Either Err a) -> IO a+eitherToError io = do+ r <- io+ case r of+ Left e -> throwError e+ Right v -> pure v++responseValue :: IO (Response a) -> IO a+responseValue req = do+ r <- req+ return $ r ^. responseBody++responseMaybe :: IO (Response a) -> IO (Maybe a)+responseMaybe req = do+ e <- try req+ case e of+ Left (_ :: HttpException) -> return Nothing+ Right r -> return $ r ^? responseBody++tryResponse :: IO (Response a) -> IO (Either Err (Response a))+tryResponse req = do+ e <- try req+ case e of+ Left (HttpExceptionRequest _ content) ->+ case content of+ (StatusCodeException _ body) ->+ case decode . LB.fromStrict $ body of+ Just er -> return $ Left er+ Nothing -> return . Left . err . B.unpack $ body+ ResponseTimeout -> return . Left . err $ "ResponseTimeout"+ other -> return . Left . err $ show other++ Left (InvalidUrlException _ _) ->+ return . Left . err $ "InvalidUrlException"+ Right r -> return $ Right r++responseEither :: IO (Response a) -> IO (Either Err a)+responseEither req = do+ rsp <- tryResponse req+ case rsp of+ Left e -> return $ Left e+ Right r -> return . Right $ r ^. responseBody++responseEither' :: IO (Response LB.ByteString) -> IO (Either Err ())+responseEither' req = do+ rsp <- tryResponse req+ case rsp of+ Left e -> return $ Left e+ Right _ -> return $ Right ()++responseEitherJSON :: FromJSON a => IO (Response LB.ByteString) -> IO (Either Err a)+responseEitherJSON req = responseEither $ asJSON =<< req++responseJSON :: FromJSON a => IO (Response LB.ByteString) -> IO a+responseJSON = eitherToError . responseEitherJSON++responseOk :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (Either Err (Ok a))+responseOk okey req = do+ rsp <- responseEitherJSON req+ case rsp of+ Left e -> return $ Left e+ Right r -> case toOk okey r of+ Just v -> return $ Right v+ Nothing -> return . Left $ err "Invalid Result"++responseOk_ :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (Ok a)+responseOk_ okey req = eitherToError (responseOk okey req)++responseList :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (Either Err (List a))+responseList okey req = do+ rsp <- responseEitherJSON req+ case rsp of+ Left e -> return $ Left e+ Right r -> case toList okey r of+ Just v -> return $ Right v+ Nothing -> return . Left $ err "Invalid Result"++responseList_ :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (List a)+responseList_ okey req = eitherToError (responseList okey req)
+ wreq-helper.cabal view
@@ -0,0 +1,31 @@+name: wreq-helper+version: 0.1.0.0+synopsis: Wreq response process+description: Wreq response process.+homepage: https://github.com/Lupino/yuntan-common/tree/master/wreq-helper#readme+license: BSD3+license-file: LICENSE+author: Li Meng Jun+maintainer: lmjubuntu@gmail.com+copyright: MIT+category: value+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Network.Wreq.Helper+ build-depends: base >= 4.7 && < 5+ , wreq+ , http-client+ , lens+ , bytestring+ , aeson+ , text+ , aeson-result+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/Lupino/yuntan-common