api-builder 0.2.0.1 → 0.4.0.0

raw patch · 8 files changed

+144/−54 lines, 8 filesdep +bifunctorsdep ~aesondep ~attoparsecdep ~http-conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: bifunctors

Dependency ranges changed: aeson, attoparsec, http-conduit, transformers

API changes (from Hackage documentation)

Files

• api-builder.cabal +10/−6
• src/Network/API/Builder.hs +5/−3
• src/Network/API/Builder/API.hs +18/−16
• src/Network/API/Builder/Decoding.hs +0/−29
• src/Network/API/Builder/Error.hs +1/−0
• src/Network/API/Builder/Examples/StackOverflow.hs +3/−0
• src/Network/API/Builder/Receive.hs +62/−0
• src/Network/API/Builder/Send.hs +45/−0

@@ -1,5 +1,5 @@ name: api-builder-version: 0.2.0.1+version: 0.4.0.0 synopsis: Library for easily building REST API wrappers in Haskell license: BSD3 author: Fraser Murray@@ -14,23 +14,27 @@     Network.API.Builder     Network.API.Builder.API     Network.API.Builder.Builder-    Network.API.Builder.Decoding     Network.API.Builder.Error     Network.API.Builder.Examples.StackOverflow     Network.API.Builder.Query+    Network.API.Builder.Receive     Network.API.Builder.Routes+    Network.API.Builder.Send   build-depends:     base >= 4.6 && < 4.8,-    aeson == 0.7.*,-    attoparsec == 0.11.*,+    aeson >= 0.7 && < 0.9,+    attoparsec >= 0.11 && < 0.13,+    bifunctors,     bytestring == 0.10.*,     either == 4.*,     HTTP == 4000.*,     http-types == 0.8.*,     http-conduit == 2.*,     text == 1.*,-    transformers == 0.3.*+    transformers >= 0.3 && < 0.5   hs-source-dirs: src/   default-language: Haskell2010-  default-extensions: OverloadedStrings+  default-extensions:+    FlexibleInstances+    OverloadedStrings   ghc-options: -Wall

@@ -2,14 +2,16 @@ module Network.API.Builder   ( module Network.API.Builder.API   , module Network.API.Builder.Builder-  , module Network.API.Builder.Decoding   , module Network.API.Builder.Error   , module Network.API.Builder.Query-  , module Network.API.Builder.Routes ) where+  , module Network.API.Builder.Receive+  , module Network.API.Builder.Routes+  , module Network.API.Builder.Send ) where  import Network.API.Builder.API import Network.API.Builder.Builder-import Network.API.Builder.Decoding import Network.API.Builder.Error import Network.API.Builder.Query+import Network.API.Builder.Receive import Network.API.Builder.Routes+import Network.API.Builder.Send

@@ -6,6 +6,7 @@   , execAPI   , runAPI   , runRoute+  , sendRoute   , routeResponse   , routeRequest   -- ** Lifting@@ -20,21 +21,21 @@   , customizeRequest ) where  import Network.API.Builder.Builder-import Network.API.Builder.Decoding import Network.API.Builder.Error+import Network.API.Builder.Receive import Network.API.Builder.Routes+import Network.API.Builder.Send +import Data.Bifunctor import Control.Exception import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Either import Control.Monad.Trans.Reader import Control.Monad.Trans.State-import Data.Aeson (FromJSON) import Data.ByteString.Lazy (ByteString) import Data.Text (Text) import Network.HTTP.Conduit-import qualified Data.Text as T  -- | Main API type. @s@ is the API's internal state, @e@ is the API's custom error type, --   and @a@ is the result when the API runs. Based on the @APIT@ transformer.@@ -89,19 +90,13 @@  -- | Runs a @Route@. Infers the type to convert to from the JSON with the @a@ in @API@, --   and infers the error type from @e@.-runRoute :: (FromJSON a, FromJSON e, MonadIO m) => Route -> APIT s e m a-runRoute route = routeResponse route >>= hoistEither . decode . responseBody+runRoute :: (Receivable a, ErrorReceivable e, MonadIO m) => Route -> APIT s e m a+runRoute = sendRoute ()  -- | Runs a @Route@, but only returns the response and does nothing towards --   decoding the response.-routeResponse :: (MonadIO m) => Route -> APIT s e m (Response ByteString)-routeResponse route = do-  b <- liftBuilder get-  m <- liftManager ask-  req <- hoistEither $ routeRequest b route `eitherOr` InvalidURLError-  do-    r <- liftIO $ try $ httpLbs req m-    hoistEither $ either (Left . HTTPError) Right r+routeResponse :: (MonadIO m, ErrorReceivable e) => Route -> APIT s e m (Response ByteString)+routeResponse = sendRoute ()  eitherOr :: Maybe a -> b -> Either b a a `eitherOr` b =@@ -109,12 +104,19 @@     Just x -> Right x     Nothing -> Left b +sendRoute :: (MonadIO m, Sendable t, ErrorReceivable e, Receivable r) => t -> Route -> APIT s e m r+sendRoute s r = do+  builder <- liftBuilder get+  manager <- liftManager ask+  req <- hoistEither $ send builder r s `eitherOr` InvalidURLError+  response <- liftIO $ try $ httpLbs req manager+  res <- hoistEither $ first HTTPError response+  hoistEither $ receive res+ -- | Try to construct a @Request@ from a @Route@ (with the help of the @Builder@). Returns @Nothing@ if --   the URL is invalid or there is another error with the @Route@. routeRequest :: Builder -> Route -> Maybe Request-routeRequest b route =-  let initialURL = parseUrl (T.unpack $ routeURL (_baseURL b) (_customizeRoute b route)) in-  fmap (\url -> _customizeRequest b $ url { method = httpMethod route }) initialURL+routeRequest b route = send b route ()  -- | Modify the @name@ of the @Builder@ from inside an API. Using this is probably not the best idea, --   it's nice if the @Builder@'s name is stable at least.

@@ -1,29 +0,0 @@-module Network.API.Builder.Decoding-  ( decode ) where--import Network.API.Builder.Error--import Data.Aeson (FromJSON, parseJSON)-import Data.Aeson.Parser (value)-import Data.Aeson.Types (parseEither)-import Data.Attoparsec.Lazy (parse, eitherResult)-import qualified Data.ByteString.Lazy as BS---- | Try to parse a value from a JSON @ByteString@, and if not, try to---   parse a useful error from the JSON. If we can't do that, complain about---   a @ParseError@.-decode :: (FromJSON a, FromJSON e) => BS.ByteString -> Either (APIError e) a-decode s =-  case eitherDecode s of-    Right x -> Right x-    Left err ->-      case eitherDecode s of-        Right x -> Left $ APIError x-        Left _ -> Left $ ParseError err---- | @Data.Aeson@'s @decode@ function will only parse a value if it's---   an array or an object, in accordance with some RFC somewhere. Unfortunately---   not all JSON APIs respect this, so we have to mess with parsers and values and---   whatnot.-eitherDecode :: (FromJSON a) => BS.ByteString -> Either String a-eitherDecode s = eitherResult (parse value s) >>= parseEither parseJSON

@@ -22,3 +22,4 @@   (APIError a) == (APIError b) = a == b   InvalidURLError == InvalidURLError = True   (ParseError a) == (ParseError b) = a == b+  _ == _ = False

@@ -25,6 +25,9 @@              <*> o .: "tags"   parseJSON _ = mempty +instance Receivable Questions where+  receive = useFromJSON+ instance FromJSON Questions where   parseJSON (Object o) = Questions <$> o .: "items"   parseJSON _ = mempty

@@ -0,0 +1,62 @@+module Network.API.Builder.Receive where++import Network.API.Builder.Error++import Data.Aeson hiding (decode, eitherDecode)+import Data.Aeson.Parser+import Data.Aeson.Types (parseEither)+import Data.Attoparsec.Lazy (parse, eitherResult)+import Data.ByteString.Lazy (ByteString)+import Network.HTTP.Conduit++class Receivable r where+  receive :: ErrorReceivable e => Response ByteString -> Either (APIError e) r++instance Receivable ByteString where+  receive = Right . responseBody++instance Receivable (Response ByteString) where+  receive = Right++instance Receivable Value where+  receive = useFromJSON++useFromJSON :: (FromJSON a, ErrorReceivable e) => Response ByteString -> Either (APIError e) a+useFromJSON resp =+  case eitherDecode $ responseBody resp of+    Left err ->+      case receiveError resp of+        Just x -> Left $ APIError x+        Nothing -> Left $ ParseError err+    Right x -> return x++class ErrorReceivable e where+  receiveError :: Response ByteString -> Maybe e++instance ErrorReceivable ByteString where+  receiveError = Just . responseBody++instance ErrorReceivable () where+  receiveError _ = Nothing++instance ErrorReceivable Value where+  receiveError = useErrorFromJSON++useErrorFromJSON :: FromJSON a => Response ByteString -> Maybe a+useErrorFromJSON resp =+  case eitherDecode (responseBody resp) of+    Right x -> Just x+    Left _ -> Nothing++eitherDecode :: FromJSON a => ByteString -> Either String a+eitherDecode s = eitherResult (parse value s) >>= parseEither parseJSON++newtype JSONResponse a = JSONResponse { unwrapJSON :: a }+  deriving (Show, Read, Eq, Ord)++instance FromJSON a => FromJSON (JSONResponse a) where+  parseJSON v = JSONResponse `fmap` parseJSON v++instance FromJSON a => Receivable (JSONResponse a) where+  receive = useFromJSON+

@@ -0,0 +1,45 @@+module Network.API.Builder.Send where++import Network.API.Builder.Builder+import Network.API.Builder.Routes++import Data.Aeson+import Data.ByteString.Lazy (ByteString)+import Network.HTTP.Conduit+import qualified Data.ByteString.Char8 as ByteString+import qualified Data.Text as Text++class Sendable s where+  send :: Builder -> Route -> s -> Maybe Request++instance Sendable () where+  send builder r () =+    case httpMethod r of+      "POST" -> do+        req <- parseUrl $ Text.unpack $ routeURL (_baseURL builder) (_customizeRoute builder r)+        return $ _customizeRequest builder $+          req { requestHeaders = ("Content-Type", "application/x-www-form-urlencoded") : requestHeaders req+              , requestBody = RequestBodyBS (dropQuestion $ queryString req)+              , queryString = ""+              , method = httpMethod r }+      _ -> do+        req <- parseUrl $ Text.unpack $ routeURL (_baseURL builder) (_customizeRoute builder r)+        return $ _customizeRequest builder $ req { method = httpMethod r }+    where dropQuestion b = if ByteString.isPrefixOf "?" b then ByteString.drop 1 b else b++instance Sendable Value where+  send builder r value =+    case httpMethod r of+      "POST" -> do+        req <- send builder r ()+        return $ req { requestBody = RequestBodyLBS (encode value)+                     , requestHeaders = ("Content-Type", "application/json") : requestHeaders req }+      _ -> Nothing++instance Sendable ByteString where+  send builder r bs =+    case httpMethod r of+      "POST" -> do+        req <- send builder r ()+        return $ req { requestBody = RequestBodyLBS bs }+      _ -> Nothing