diff --git a/Examples.hs b/Examples.hs --- a/Examples.hs +++ b/Examples.hs @@ -13,10 +13,12 @@ import qualified Web.Hyperpublic.Places as Places import qualified Web.Hyperpublic.Offers as Offers + -- Sequence the two examples. main :: IO () main = placeNamesNearHq >> offerDescr + -- Find places near Hyperpublic HQ and print the name of each. placeNamesNearHq :: IO () placeNamesNearHq = @@ -34,6 +36,7 @@ in json >>= putStrLn . show . getDescr where getDescr (Object obj) = maybe "" id $ getTextField obj "description" + -- Create an authorization record. Get your own credentials at -- http://www.hyperpublic.com/registerapi diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,3 +1,18 @@ A thin Haskell wrapper for the [Hyperpublic](http://hyperpublic.com/) API. See -the documentation on the -[Hackage page](http://hackage.haskell.org/package/hyperpublic). +the [Hackage page](http://hackage.haskell.org/package/hyperpublic) for library +documentation and examples. + +A Note on Version Numbers +------------------------- + +This package adheres to the following convention regarding version +numbers: + + x.y.z + ++ `x` -- Major digit, denotes structural changes to the library's exposed + modules. Application code will probably require updates. ++ `y` -- Minor digit, denotes feature additions. Application code will not + require updates. ++ `z` -- Bugfix digit, denotes bug fixes. Application code will not require + updates. diff --git a/Web/Hyperpublic.hs b/Web/Hyperpublic.hs --- a/Web/Hyperpublic.hs +++ b/Web/Hyperpublic.hs @@ -1,20 +1,17 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_HADDOCK prune #-} - --- | A thin wrapper for the Hyperpublic API, which uses --- "Network.HTTP.Enumerator" to fetch results and "Data.Aeson" to return them --- as JSON. The "Web.Hyperpublic.Places" and "Web.Hyperpublic.Offers" modules --- wrap @find@ and @show@ methods of the Places+ --- () and Geo Deals and Events --- () endpoints, respectively. The next --- release of this package will also wrap the @create@ method of Places+. Full --- API documentation can be found at . +-- | A thin wrapper for the Hyperpublic API, which uses @http-enumerator@ to +-- fetch results and @aeson@ to return them as JSON. Full documentation for the +-- Hyperpublic API can be found at . -- --- "Web.Hyperpublic.Places" and "Web.Hyperpublic.Offers" export the functions --- @find@ and @show@, where each works similarly across the two modules. The --- next release of this package will also wrap the @create@ method of Places+. +-- The exposed functions of these modules follow a simple pattern: each takes +-- an 'HpAuth' record as well as either a 'ByteString' (for @show@ methods on +-- the API) or a 'Network.HTTP.Types.SimpleQuery' (for @find@ or @create@ +-- methods on the API). -- --- Examples (included in the distribution as @Examples.hs@): +-- Some basic usage examples follow. (This code is included in the distribution +-- as @Examples.hs@. Call @cabal-install@ with @-f example@ and it will build +-- an executable called @hyperpublic-example@.) Usage questions may be posted +-- on the Hyperpublic API Developers mailing list at +-- . -- -- >{-# LANGUAGE OverloadedStrings #-} -- > @@ -31,10 +28,12 @@ -- >import qualified Web.Hyperpublic.Places as Places -- >import qualified Web.Hyperpublic.Offers as Offers -- > +-- > -- >-- Sequence the two examples. -- >main :: IO () -- >main = placeNamesNearHq >> offerDescr -- > +-- > -- >-- Find places near Hyperpublic HQ and print the name of each. -- >placeNamesNearHq :: IO () -- >placeNamesNearHq = @@ -53,6 +52,7 @@ -- > where -- > getDescr (Object obj) = maybe "" id $ getTextField obj "description" -- > +-- > -- >-- Create an authorization record. Get your own credentials at -- >-- http://www.hyperpublic.com/registerapi -- >auth :: HpAuth @@ -67,59 +67,13 @@ -- > resultToMaybe (Error _) = Nothing module Web.Hyperpublic ( HpAuth (..) -, callApi ) where -import Data.Aeson ( Value - , json ) -import Data.Attoparsec ( eitherResult - , parse ) -import Data.ByteString ( ByteString - , append ) -import Data.ByteString.Char8 ( unpack ) -import qualified Data.ByteString.Lazy as Lazy - -import Network.HTTP.Enumerator ( Request (..) - , Response (..) - , def - , httpLbsRedirect - , withManager ) -import Network.HTTP.Types ( SimpleQuery - , simpleQueryToQuery ) +import Data.ByteString ( ByteString ) -callApi :: HpAuth -> ByteString -> SimpleQuery -> IO Value -callApi auth urlPath query = do - let query' = [ ("client_id", clientId auth) - , ("client_secret", clientSecret auth) ] ++ - filter cleanQuery query - rsp <- withManager (httpLbsRedirect $ request urlPath query') - eitherToIO $ Right rsp >>= readResponse >>= eitherResult . parse json - where - cleanQuery (k, _) = k /= "client_id" && k /= "client_secret" - -- | A record for passing around API authorization credentials. data HpAuth = HpAuth { clientId :: ByteString , clientSecret :: ByteString } deriving (Show) - - -request :: ByteString -> SimpleQuery -> Request m -request urlPath query = def - { host = "api.hyperpublic.com" - , path = "/api/v1" `append` urlPath - , queryString = simpleQueryToQuery query - , port = 443 - , secure = True } - -readResponse :: Response -> Either String ByteString -readResponse rsp = - let strictBody = foldr1 append $ Lazy.toChunks $ responseBody rsp - in if statusCode rsp == 200 - then Right strictBody - else Left $ unpack strictBody - -eitherToIO :: Either String a -> IO a -eitherToIO (Right a) = return a -eitherToIO (Left str) = fail str diff --git a/Web/Hyperpublic/Categories.hs b/Web/Hyperpublic/Categories.hs new file mode 100644 --- /dev/null +++ b/Web/Hyperpublic/Categories.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Wrappers for calling the methods of the Hyperpublic Categories endpoint. +module Web.Hyperpublic.Categories +( show +, find +) where + +import Prelude hiding ( show ) + +import Data.Aeson ( Value ) +import Data.ByteString ( ByteString + , append ) +import Data.ByteString.Char8 () + +import Network.HTTP.Types ( StdMethod (..) ) + +import Web.Hyperpublic +import Web.Hyperpublic.Internal + + +-- | Call the show method of the Categories endpoint. API documentation at +-- +show :: HpAuth -- ^ API authorization + -> ByteString -- ^ The id of the category to be returned + -> IO Value -- ^ JSON output +show auth hpId = callApi auth GET ("/categories/" `append` hpId) [] + +-- | Call the find method of the Categories endpoint, which simply lists the +-- full category hierarchy. (The endpoint does not currently support more +-- specific queries.) API documentation at +-- +find :: HpAuth -- ^ API authorization + -> IO Value -- ^ JSON output +find auth = callApi auth GET "/categories" [] diff --git a/Web/Hyperpublic/Internal.hs b/Web/Hyperpublic/Internal.hs new file mode 100644 --- /dev/null +++ b/Web/Hyperpublic/Internal.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Web.Hyperpublic.Internal +( callApi +) where + +import Data.Aeson ( Value + , json ) +import Data.Attoparsec ( eitherResult + , parse ) +import Data.ByteString ( ByteString + , append ) +import Data.ByteString.Char8 ( unpack ) +import qualified Data.ByteString.Lazy as Lazy + +import Network.HTTP.Enumerator ( Request (..) + , Response (..) + , def + , httpLbsRedirect + , withManager ) +import Network.HTTP.Types ( SimpleQuery + , StdMethod (..) + , renderStdMethod + , simpleQueryToQuery ) + +import Web.Hyperpublic + + +callApi :: HpAuth -> StdMethod -> ByteString -> SimpleQuery -> IO Value +callApi auth mthd urlPath query = do + let query' = [ ("client_id", clientId auth) + , ("client_secret", clientSecret auth) ] ++ + filter cleanQuery query + rsp <- withManager (httpLbsRedirect $ request mthd urlPath query') + eitherToIO $ Right rsp >>= readResponse >>= eitherResult . parse json + where + cleanQuery (k, _) = k /= "client_id" && k /= "client_secret" + +request :: StdMethod -> ByteString -> SimpleQuery -> Request m +request mthd urlPath query = def + { method = renderStdMethod mthd + , host = "api.hyperpublic.com" + , path = "/api/v1" `append` urlPath + , queryString = simpleQueryToQuery query + , port = 443 + , secure = True } + +readResponse :: Response -> Either String ByteString +readResponse rsp = + let strictBody = foldr1 append $ Lazy.toChunks $ responseBody rsp + in if statusCode rsp == 200 + then Right strictBody + else Left $ show (statusCode rsp) ++ ": " ++ unpack strictBody + +eitherToIO :: Either String a -> IO a +eitherToIO (Right a) = return a +eitherToIO (Left str) = fail str diff --git a/Web/Hyperpublic/Offers.hs b/Web/Hyperpublic/Offers.hs --- a/Web/Hyperpublic/Offers.hs +++ b/Web/Hyperpublic/Offers.hs @@ -1,29 +1,36 @@ {-# LANGUAGE OverloadedStrings #-} --- | See the usage examples in the "Web.Hyperpublic" documentation. +-- | Wrappers for calling the methods of the Hyperpublic Geo Deals and Events +-- endpoint. module Web.Hyperpublic.Offers -where +( show +, find +) where +import Prelude hiding ( show ) + import Data.Aeson ( Value ) import Data.ByteString ( ByteString , append ) import Data.ByteString.Char8 () -import Network.HTTP.Types ( SimpleQuery ) +import Network.HTTP.Types ( SimpleQuery + , StdMethod (..) ) import Web.Hyperpublic +import Web.Hyperpublic.Internal -- | Call the show method of the Geo Deals and Events endpoint. API -- documentation at show :: HpAuth -- ^ API authorization - -> ByteString -- ^ The id of the place to be returned + -> ByteString -- ^ The id of the offer to be returned -> IO Value -- ^ JSON output -show auth hpId = callApi auth ("/offers/" `append` hpId) [] +show auth hpId = callApi auth GET ("/offers/" `append` hpId) [] -- | Call the find method of the Geo Deals and Events endpoint. API -- documentation at find :: HpAuth -- ^ API authorization -> SimpleQuery -- ^ Query parameters -> IO Value -- ^ JSON output -find auth query = callApi auth "/offers" query +find auth query = callApi auth GET "/offers" query diff --git a/Web/Hyperpublic/Places.hs b/Web/Hyperpublic/Places.hs --- a/Web/Hyperpublic/Places.hs +++ b/Web/Hyperpublic/Places.hs @@ -1,17 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} --- | See the usage examples in the "Web.Hyperpublic" documentation. +-- | Wrappers for calling the methods of the Hyperpublic Places+ endpoint. module Web.Hyperpublic.Places -where +( show +, find +, create +) where +import Prelude hiding ( show ) + import Data.Aeson ( Value ) import Data.ByteString ( ByteString , append ) import Data.ByteString.Char8 () -import Network.HTTP.Types ( SimpleQuery ) +import Network.HTTP.Types ( SimpleQuery + , StdMethod (..) ) import Web.Hyperpublic +import Web.Hyperpublic.Internal -- | Call the show method of the Places+ endpoint. API documentation at @@ -19,11 +26,18 @@ show :: HpAuth -- ^ API authorization -> ByteString -- ^ The id of the place to be returned -> IO Value -- ^ JSON output -show auth hpId = callApi auth ("/places/" `append` hpId) [] +show auth hpId = callApi auth GET ("/places/" `append` hpId) [] -- | Call the find method of the Places+ endpoint. API documentation at -- find :: HpAuth -- ^ API authorization -> SimpleQuery -- ^ Query parameters -> IO Value -- ^ JSON output -find auth query = callApi auth "/places" query +find auth query = callApi auth GET "/places" query + +-- | Call the create method of the Places+ endpoint. API documentation at +-- +create :: HpAuth -- ^ API authorization + -> SimpleQuery -- ^ Query parameters + -> IO Value -- ^ JSON output +create auth query = callApi auth POST "/places" query diff --git a/hyperpublic.cabal b/hyperpublic.cabal --- a/hyperpublic.cabal +++ b/hyperpublic.cabal @@ -1,5 +1,5 @@ name: hyperpublic -version: 0.0.0 +version: 0.1.0 cabal-version: >= 1.6 build-type: Simple license: PublicDomain @@ -10,11 +10,16 @@ bug-reports: https://github.com/mkscrg/hyperpublic-haskell/issues synopsis: A thin wrapper for the Hyperpublic API description: - A thin wrapper for the Hyperpublic API, which uses "Network.HTTP.Enumerator" - to fetch results and "Data.Aeson" to return them as JSON. + A thin wrapper for the Hyperpublic API, which uses @http-enumerator@ to fetch + results and @aeson@ to return them as JSON. category: Web extra-source-files: README.md, Examples.hs +flag example + description: Build Examples.hs into the hyperpublic-example executable. + default: False + manual: True + library -- Very conservative lower bounds here. Notify me when you find wider -- compatibility boundaries and I'll update them here. @@ -26,9 +31,30 @@ http-enumerator >= 0.7.1.3 && < 0.8, http-types >= 0.6.5.1 && < 0.7 exposed-modules: - Web.Hyperpublic, Web.Hyperpublic.Places, Web.Hyperpublic.Offers + Web.Hyperpublic, + Web.Hyperpublic.Places, + Web.Hyperpublic.Offers, + Web.Hyperpublic.Categories + other-modules: + Web.Hyperpublic.Internal extensions: OverloadedStrings ghc-options: -Wall + +executable hyperpublic-example + build-depends: + aeson >= 0.3.2.12 && < 0.4, + base >= 4.0 && < 5.0, + bytestring >= 0.9.2.0 && < 0.9.99, + containers >= 0.4.1.0 && < 0.5, + text >= 0.11.1.6 && < 0.12, + vector >= 0.9 && < 0.9.99 + other-modules: + Web.Hyperpublic, Web.Hyperpublic.Places, Web.Hyperpublic.Offers + main-is: Examples.hs + if flag(example) + buildable: True + else + buildable: False source-repository head type: git