api-builder (empty) → 0.1.0.0

raw patch · 9 files changed

+263/−0 lines, 9 filesdep +HTTPdep +aesondep +attoparsecsetup-changed

Dependencies added: HTTP, aeson, attoparsec, base, bytestring, either, http-conduit, text, transformers

Files

Setup.hs +2/−0
api-builder.cabal +34/−0
src/APIBuilder.hs +8/−0
src/APIBuilder/API.hs +74/−0
src/APIBuilder/Builder.hs +20/−0
src/APIBuilder/Decoding.hs +22/−0
src/APIBuilder/Error.hs +10/−0
src/APIBuilder/Examples/StackOverflow.hs +41/−0
src/APIBuilder/Routes.hs +52/−0

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ api-builder.cabal view

@@ -0,0 +1,34 @@+name: api-builder+version: 0.1.0.0+synopsis: Library for easily building REST API wrappers in Haskell+license: BSD3+author: Fraser Murray+maintainer: fraser.m.murray@gmail.com+copyright: (c) Fraser Murray 2014+category: Network+build-type: Simple+cabal-version: >= 1.10++library+  exposed-modules: +    APIBuilder+    APIBuilder.API+    APIBuilder.Builder+    APIBuilder.Decoding+    APIBuilder.Error+    APIBuilder.Examples.StackOverflow+    APIBuilder.Routes+  build-depends: +    base >= 4.6 && < 4.8,+    aeson == 0.7.*,+    attoparsec == 0.11.*,+    bytestring == 0.10.*,+    either == 4.*,+    HTTP == 4000.*,+    http-conduit == 2.*,+    text == 1.*,+    transformers == 0.3.*+  hs-source-dirs: src/+  default-language: Haskell2010+  default-extensions: OverloadedStrings, RankNTypes+  ghc-options: -Wall

+ src/APIBuilder.hs view

@@ -0,0 +1,8 @@+module APIBuilder +  ( module Exports ) where++import APIBuilder.API as Exports+import APIBuilder.Builder as Exports+import APIBuilder.Decoding as Exports+import APIBuilder.Error as Exports+import APIBuilder.Routes as Exports

+ src/APIBuilder/API.hs view

@@ -0,0 +1,74 @@+module APIBuilder.API+  ( API +  , liftEither+  , liftBuilder+  , liftState+  , runAPI+  , runRoute+  , routeRequest+  , name+  , baseURL+  , customizeRoute+  , customizeRequest ) where++import APIBuilder.Builder+import APIBuilder.Decoding+import APIBuilder.Error+import APIBuilder.Routes++import Control.Exception+import Control.Monad.Trans.Either+import Control.Monad.Trans.State+import Control.Monad.Trans.Class (lift)+import Control.Monad.IO.Class (liftIO)+import Data.Aeson (FromJSON)+import Data.Text (Text)+import qualified Data.ByteString.Char8 as BS+import qualified Data.Text as T+import Network.HTTP.Conduit++type API s e a = EitherT (APIError e) (StateT Builder (StateT s IO)) a++liftEither :: API s e a -> API s e a+liftEither = id ++liftBuilder :: StateT Builder (StateT s IO) a -> API s e a+liftBuilder = lift++liftState :: StateT s IO a -> API s e a+liftState = lift . lift++runAPI :: Builder -> s -> API s e a -> IO (Either (APIError e) a)+runAPI b s api = evalStateT (evalStateT (runEitherT api) b) s++runRoute :: (FromJSON a, FromJSON e) => Route -> API s e a+runRoute 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++eitherOr :: Maybe a -> b -> Either b a+a `eitherOr` b =+  case a of +    Just x -> Right x+    Nothing -> Left b++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 = BS.pack (showMethod $ httpMethod route) }) initialURL++name :: Text -> API s e ()+name t = liftBuilder $ modify (\b -> b { _name = t })++baseURL :: Text -> API s e ()+baseURL t = liftBuilder $ modify (\b -> b { _baseURL = t })++customizeRoute :: (Route -> Route) -> API s e ()+customizeRoute f = liftBuilder $ modify (\b -> b { _customizeRoute = f })++customizeRequest :: (Request -> Request) -> API s e ()+customizeRequest f = liftBuilder $ modify (\b -> b { _customizeRequest = f })

+ src/APIBuilder/Builder.hs view

@@ -0,0 +1,20 @@+module APIBuilder.Builder+  ( Builder(..)+  , basicBuilder ) where++import APIBuilder.Routes++import Network.HTTP.Conduit (Request)+import Data.Text (Text)+import qualified Data.Text as T++data Builder = Builder { _name :: Text+                       , _baseURL :: Text+                       , _customizeRoute :: Route -> Route+                       , _customizeRequest :: Request -> Request }++instance Show Builder where+  show b = "Builder { name = " ++ T.unpack (_name b) ++ "}"++basicBuilder :: Text -> Text -> Builder+basicBuilder n b = Builder n b id id

+ src/APIBuilder/Decoding.hs view

@@ -0,0 +1,22 @@+module APIBuilder.Decoding+  ( decode ) where++import APIBuilder.Error++import Data.Aeson.Types (parseEither)+import Data.Aeson.Parser (value)+import Data.Aeson (FromJSON, parseJSON)+import Data.Attoparsec.Lazy (parse, eitherResult)+import qualified Data.ByteString.Lazy as BS++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++eitherDecode :: (FromJSON a) => BS.ByteString -> Either String a+eitherDecode s = eitherResult (parse value s) >>= parseEither parseJSON

+ src/APIBuilder/Error.hs view

@@ -0,0 +1,10 @@+module APIBuilder.Error+  ( APIError(..) ) where++import Network.HTTP.Conduit (HttpException)++data APIError a = APIError a+                | HTTPError HttpException+                | InvalidURLError+                | ParseError String+  deriving Show

+ src/APIBuilder/Examples/StackOverflow.hs view

@@ -0,0 +1,41 @@+module APIBuilder.Examples.StackOverflow where++import APIBuilder+import Control.Applicative+import Data.Aeson+import Data.Monoid (mempty)+import Data.Text (Text)++data Question = Question { title :: Text+                         , isAnswered :: Bool+                         , score :: Int+                         , tags :: [Text] }+  deriving (Show, Eq)++newtype Questions = Questions [Question]+  deriving (Show, Eq)++instance FromJSON Question where+  parseJSON (Object o) =+    Question <$> o .: "title"+             <*> o .: "is_answered"+             <*> o .: "score"+             <*> o .: "tags"+  parseJSON _ = mempty++instance FromJSON Questions where+  parseJSON (Object o) = Questions <$> o .: "items"+  parseJSON _ = mempty++stackOverflow :: Builder+stackOverflow = basicBuilder "StackOverflow API" "http://api.stackexchange.com"++answersRoute :: Route+answersRoute = Route { fragments = [ "2.2", "questions" ]+                     , urlParams = [ "order" =. Just "desc"+                                   , "sort" =. Just "activity"+                                   , "site" =. Just "stackoverflow" ]+                     , httpMethod = GET }++getAnswers :: IO (Either (APIError ()) Questions)+getAnswers = runAPI stackOverflow () $ runRoute answersRoute

+ src/APIBuilder/Routes.hs view

@@ -0,0 +1,52 @@+module APIBuilder.Routes+  ( URLFragment+  , URLParam+  , Route(..)+  , HTTPMethod(..)+  , showMethod+  , routeURL+  , (=.) ) where++import Control.Arrow ((***))+import Data.Maybe (mapMaybe)+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Network.HTTP.Base as HTTP (urlEncodeVars)++type URLFragment = Text+type URLParam = (Text, Maybe Text)++(=.) :: Text -> Maybe Text -> (Text, Maybe Text)+(=.) = (,)++data Route = Route { fragments :: [URLFragment]+                   , urlParams :: [URLParam]+                   , httpMethod :: HTTPMethod }+  deriving (Show, Read, Eq)++data HTTPMethod = GET+                | POST+                | CustomMethod Text+  deriving (Show, Read, Eq)++showMethod :: HTTPMethod -> String+showMethod GET = "GET"+showMethod POST = "POST"+showMethod (CustomMethod t) = T.unpack t++routeURL :: Text -> Route -> Text+routeURL baseURL (Route fs ps _) =+  let path = T.intercalate "/" fs+  in baseURL <> "/" <> path <> pathParamsSep fs <> buildParams ps++pathParamsSep :: [URLFragment] -> Text+pathParamsSep [] = "?"+pathParamsSep xs = if T.isInfixOf "." (last xs) then "?" else "/?"++buildParams :: [URLParam] -> Text+buildParams = T.pack . HTTP.urlEncodeVars . map (T.unpack *** T.unpack) . mapMaybe collectParams++collectParams :: URLParam -> Maybe (Text, Text)+collectParams (a, Just x) = Just (a,x)+collectParams (_, Nothing) = Nothing