api-builder 0.1.0.1 → 0.1.1.0

raw patch · 8 files changed

+92/−64 lines, 8 filesdep +http-typesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-types

API changes (from Hackage documentation)

Files

• api-builder.cabal +6/−4
• src/APIBuilder.hs +1/−1
• src/APIBuilder/API.hs +35/−23
• src/APIBuilder/Builder.hs +1/−1
• src/APIBuilder/Decoding.hs +4/−4
• src/APIBuilder/Examples/StackOverflow.hs +4/−4
• src/APIBuilder/Query.hs +28/−0
• src/APIBuilder/Routes.hs +13/−27

@@ -1,5 +1,5 @@ name: api-builder-version: 0.1.0.1+version: 0.1.1.0 synopsis: Library for easily building REST API wrappers in Haskell license: BSD3 author: Fraser Murray@@ -10,25 +10,27 @@ cabal-version: >= 1.10  library-  exposed-modules: +  exposed-modules:     APIBuilder     APIBuilder.API     APIBuilder.Builder     APIBuilder.Decoding     APIBuilder.Error     APIBuilder.Examples.StackOverflow+    APIBuilder.Query     APIBuilder.Routes-  build-depends: +  build-depends:     base >= 4.6 && < 4.8,     aeson == 0.7.*,     attoparsec == 0.11.*,     bytestring == 0.10.*,     either == 4.*,     HTTP == 4000.*,+    http-types == 0.8.*,     http-conduit == 2.*,     text == 1.*,     transformers == 0.3.*   hs-source-dirs: src/   default-language: Haskell2010-  default-extensions: OverloadedStrings, RankNTypes+  default-extensions: OverloadedStrings   ghc-options: -Wall

@@ -1,6 +1,6 @@ -- | Exports a bunch of stuff. Check 'APIBuilder.API', 'APIBuilder.Builder', --   'APIBuilder.Decoding', 'APIBuilder.Error', and 'APIBuilder.Routes'.-module APIBuilder +module APIBuilder   ( module Exports ) where  import APIBuilder.API as Exports

@@ -1,9 +1,11 @@ module APIBuilder.API (   -- * API-    API +    API+  , APIT   -- ** Running the API   , runAPI   , runRoute+  , routeResponse   , routeRequest   -- ** Lifting   , liftEither@@ -24,81 +26,91 @@ import Control.Monad.Trans.Either import Control.Monad.Trans.State import Control.Monad.Trans.Class (lift)-import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson (FromJSON) import Data.Text (Text)-import qualified Data.ByteString.Char8 as BS import qualified Data.Text as T+import Data.ByteString.Lazy (ByteString) import Network.HTTP.Conduit  -- | 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.+type API s e a = APIT s e IO a++-- | Main API transformer 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.-type API s e a = EitherT (APIError e) (StateT Builder (StateT s IO)) a+type APIT s e m a = EitherT (APIError e) (StateT Builder (StateT s m)) a  -- | Lifts an action that works on an @API@ to an action that works on an @API@. --   This function is provided solely for future-proofing in the case that more transformers --   need to be stacked on top - it's implemented simply as @id@ for the moment.-liftEither :: EitherT (APIError e) (StateT Builder (StateT s IO)) a -> API s e a+liftEither :: Monad m => EitherT (APIError e) (StateT Builder (StateT s m)) a -> APIT s e m a liftEither = id  -- | Lifts an action that operates on a @Builder@ to one that works on an @API@. Useful --   mainly for gaining access to a @Builder@ from inside an @API@.-liftBuilder :: StateT Builder (StateT s IO) a -> API s e a+liftBuilder :: Monad m => StateT Builder (StateT s m) a -> APIT s e m a liftBuilder = lift  -- | Lifts an action on an @API@'s state type @s@ to one that works on the @API@. Good---   for messing with the state from inside the @API@. -liftState :: StateT s IO a -> API s e a+--   for messing with the state from inside the @API@.+liftState :: Monad m => StateT s m a -> APIT s e m a liftState = lift . lift  -- | Runs an @API@ by executing its transformer stack and dumping it all into @IO@.-runAPI :: Builder -- ^ initial @Builder@ for the @API@ +runAPI :: MonadIO m+       => Builder -- ^ initial @Builder@ for the @API@        -> s -- ^ initial state @s@ for the @API@-       -> API s e a -- ^ the actual @API@ to run-       -> IO (Either (APIError e) a) -- ^ IO action that returns either an error or the result+       -> APIT s e m a -- ^ the actual @API@ to run+       -> m (Either (APIError e) a) -- ^ IO action that returns either an error or the result runAPI b s api = evalStateT (evalStateT (runEitherT api) b) s  -- | 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) => Route -> API s e a-runRoute route = do+runRoute :: (FromJSON a, FromJSON e, MonadIO m) => Route -> APIT s e m a+runRoute route = routeResponse route >>= hoistEither . decode . responseBody+++-- | 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   req <- hoistEither $ routeRequest b route `eitherOr` InvalidURLError   resp <- do     r <- liftIO $ try $ withManager (httpLbs req)-    hoistEither $ either (Left . HTTPError) Right r -  hoistEither $ decode $ responseBody resp+    hoistEither $ either (Left . HTTPError) Right r+  return resp  eitherOr :: Maybe a -> b -> Either b a a `eitherOr` b =-  case a of +  case a of     Just x -> Right x     Nothing -> Left b  -- | 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 = +routeRequest b route =   let initialURL = parseUrl (T.unpack $ routeURL (_baseURL b) (_customizeRoute b route)) in-  fmap (\url -> _customizeRequest b $ url { method = BS.pack (showMethod $ httpMethod route) }) initialURL+  fmap (\url -> _customizeRequest b $ url { method = httpMethod route }) initialURL  -- | 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.-name :: Text -> API s e ()+name :: Monad m => Text -> APIT s e m () name t = liftBuilder $ modify (\b -> b { _name = t })  -- | Modify the @baseURL@ of the @Builder@ from inside an API. --   Can be useful for changing the API's endpoints for certain requests.-baseURL :: Text -> API s e ()+baseURL :: Monad m => Text -> APIT s e m () baseURL t = liftBuilder $ modify (\b -> b { _baseURL = t })  -- | Modify every @Route@ before it runs. Useful for adding extra params to every query, --   for example.-customizeRoute :: (Route -> Route) -> API s e ()+customizeRoute :: Monad m => (Route -> Route) -> APIT s e m () customizeRoute f = liftBuilder $ modify (\b -> b { _customizeRoute = f }) - -- | Modify every @Request@ before the API fetches it. Useful for adding headers to every request, --   for example.-customizeRequest :: (Request -> Request) -> API s e ()+customizeRequest :: Monad m => (Request -> Request) -> APIT s e m () customizeRequest f = liftBuilder $ modify (\b -> b { _customizeRequest = f })

@@ -23,4 +23,4 @@ basicBuilder :: Text -- ^ name              -> Text -- ^ base url              -> Builder -- ^ a simple @Builder@-basicBuilder n b = Builder n b id id +basicBuilder n b = Builder n b id id

@@ -13,17 +13,17 @@ --   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 = +decode s =   case eitherDecode s of     Right x -> Right x     Left err ->-      case eitherDecode s of +      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 +-- | @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 +--   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

@@ -34,10 +34,10 @@  answersRoute :: Route answersRoute = Route { fragments = [ "2.2", "questions" ]-                     , urlParams = [ "order" =. Just "desc"-                                   , "sort" =. Just "activity"-                                   , "site" =. Just "stackoverflow" ]-                     , httpMethod = GET }+                     , urlParams = [ "order" =. ("desc" :: Text)+                                   , "sort" =. ("activity" :: Text)+                                   , "site" =. ("stackoverflow" :: Text) ]+                     , httpMethod = "GET" }  getAnswers :: IO (Either (APIError ()) Questions) getAnswers = runAPI stackOverflow () $ runRoute answersRoute

@@ -0,0 +1,28 @@+module APIBuilder.Query where++import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as Text++class ToQuery a where+  toQuery :: a -> Maybe Text++instance ToQuery Integer where+  toQuery = Just . Text.pack . show++instance ToQuery Bool where+  toQuery True = Just "true"+  toQuery False = Just "false"++instance ToQuery Int where+  toQuery = Just . Text.pack . show++instance ToQuery Text where+  toQuery = Just++instance ToQuery a => ToQuery (Maybe a) where+  toQuery (Just a) = toQuery a+  toQuery Nothing = Nothing++instance ToQuery a => ToQuery [a] where+  toQuery = Just . Text.intercalate "," . mapMaybe toQuery

@@ -3,8 +3,6 @@   , URLFragment   , URLParam   , (=.)-  , HTTPMethod(..)-  , showMethod   , routeURL ) where  import Control.Arrow ((***))@@ -13,7 +11,10 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Network.HTTP.Base as HTTP (urlEncodeVars)+import qualified Network.HTTP.Types.Method as HTTP +import APIBuilder.Query+ -- | Alias for @Text@ to store the URL fragments for each @Route@. type URLFragment = Text @@ -21,38 +22,23 @@ --   tacked onto the request. type URLParam = (Text, Maybe Text) --- | Convenience function for building @URLParam@s.--- --- >>> "api_type" =. Just "json"+-- | Convenience function for building @URLParam@s. Right-hand argument must+--   have a @ToQuery@ instance so it can be converted to the appropriate+--   representation in a query string. Query values do not need to be+--   escaped.+--+-- >>> "api_type" =. ("json" :: Text) -- ("api_type", Just "json")-(=.) :: Text -> Maybe Text -> (Text, Maybe Text)-(=.) = (,)+(=.) :: ToQuery a => Text -> a -> (Text, Maybe Text)+k =. v = (k, toQuery v) --- | Main type for routes in the API. Used to represent the URL minus the actual +-- | Main type for routes in the API. Used to represent the URL minus the actual --   endpoint URL as well as the query string and the HTTP method used to communicate --   with the server. data Route = Route { fragments :: [URLFragment]                    , urlParams :: [URLParam]-                   , httpMethod :: HTTPMethod }-  deriving (Show, Read, Eq)---- | Type for different HTTP request methods. Has the two most common ones (GET and POST)---   as well as support for custom methods.-data HTTPMethod = GET-                | POST-                | CustomMethod Text+                   , httpMethod :: HTTP.Method }   deriving (Show, Read, Eq)---- | Get a @String@ from a HTTPMethod. Used mostly for creating @Request@s.------ >>> showMethod GET--- "GET"--- >>> showMethod (CustomMethod "PATCH")--- "PATCH"-showMethod :: HTTPMethod -> String-showMethod GET = "GET"-showMethod POST = "POST"-showMethod (CustomMethod t) = T.unpack t  -- | Converts a Route to a URL. Drops any @Nothing@ values from the query, separates the --   fragments with "/" and tacks them onto the end of the base URL.