rakuten 0.1.0.0 → 0.1.0.1
raw patch · 16 files changed
+624/−602 lines, 16 filesdep ~http-types
Dependency ranges changed: http-types
Files
- LICENSE +21/−21
- rakuten.cabal +3/−3
- src/Rakuten.hs +15/−12
- src/Rakuten/Client.hs +52/−50
- src/Rakuten/Endpoints.hs +6/−5
- src/Rakuten/Endpoints/Ichiba.hs +37/−26
- src/Rakuten/Types.hs +8/−9
- src/Rakuten/Types/Base.hs +13/−13
- src/Rakuten/Types/Class.hs +94/−87
- src/Rakuten/Types/Error.hs +23/−23
- src/Rakuten/Types/Ichiba.hs +225/−226
- test/Rakuten/Endpoints/IchibaSpec.hs +29/−29
- test/Rakuten/Test/Class.hs +36/−36
- test/Rakuten/Test/Client.hs +20/−20
- test/Rakuten/Test/MockServer.hs +41/−41
- test/Spec.hs +1/−1
LICENSE view
@@ -1,21 +1,21 @@-MIT License--Copyright (c) 2017 MATSUBARA Nobutada--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-SOFTWARE.+MIT License + +Copyright (c) 2017 MATSUBARA Nobutada + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE.
rakuten.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: rakuten-version: 0.1.0.0+version: 0.1.0.1 synopsis: The Rakuten API in Haskell description: See README at <https://github.com/matsubara0507/rakuten#readme> homepage: https://github.com/matsubara0507/rakuten#readme@@ -48,7 +48,7 @@ , http-api-data >=0.3.5 && <0.3.8 , http-client >=0.5.5.0 && <0.6 , http-client-tls >=0.3.3.1 && <0.4- , http-types >=0.9.1 && <0.10+ , http-types >=0.9.1 && <0.11 , lens >=4.15.3 && <5.0 , req >=0.3.0 && <0.5 , text >=1.2.2.1 && <1.3@@ -73,7 +73,7 @@ , http-api-data >=0.3.5 && <0.3.8 , http-client >=0.5.5.0 && <0.6 , http-client-tls >=0.3.3.1 && <0.4- , http-types >=0.9.1 && <0.10+ , http-types >=0.9.1 && <0.11 , lens >=4.15.3 && <5.0 , req >=0.3.0 && <0.5 , text >=1.2.2.1 && <1.3
src/Rakuten.hs view
@@ -1,12 +1,15 @@-module Rakuten (- -- * Define about Rakuten Client- module Rakuten.Client- -- * Endpoint function definitions- , module Rakuten.Endpoints- -- * Response and request param type definitions- , module Rakuten.Types- ) where--import Rakuten.Client-import Rakuten.Endpoints-import Rakuten.Types+-- | +-- This module is re-export all endpoint functions and types from this package. +-- +module Rakuten ( + -- * Define about Rakuten Client + module Rakuten.Client + -- * Endpoint function definitions + , module Rakuten.Endpoints + -- * Response and request param type definitions + , module Rakuten.Types + ) where + +import Rakuten.Client +import Rakuten.Endpoints +import Rakuten.Types
src/Rakuten/Client.hs view
@@ -1,50 +1,52 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE OverloadedLabels #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-}--module Rakuten.Client (- AppId- , RakutenClient- , defaultRaktenClient- , Client(..)- ) where--import Control.Lens hiding ((:>))-import Data.Default.Class (Default (def))-import Data.Extensible-import Data.Function ((&))-import Data.Text (Text)-import Network.HTTP.Req (Option, Scheme (Https), Url, https, (/:),- (=:))-import Rakuten.Types--type AppId = Text--type RakutenClient =- Record '[- "applicationId" ':> Text,- "affiliateId" ':> Maybe Text,- "callback" ':> Maybe Text,- "elements" ':> [Text]- ]--defaultRaktenClient :: AppId -> RakutenClient-defaultRaktenClient appId = def & #applicationId .~ appId---- |--- By using type class, the same functions can be used for mock servers and local hosts.-class Client a where- type ClientScheme a :: Scheme- baseUrl :: a -> Url (ClientScheme a)- mkHeader :: a -> Option scheme--instance Client RakutenClient where- type ClientScheme RakutenClient = 'Https- baseUrl = const (https "app.rakuten.co.jp" /: "services" /: "api")- mkHeader = mappend ("format" =: ("json" :: Text)) . toParams+{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Rakuten.Client ( + AppId + , RakutenClient + , defaultRaktenClient + , Client(..) + ) where + +import Control.Lens hiding ((:>)) +import Data.Default.Class (Default (def)) +import Data.Extensible +import Data.Function ((&)) +import Data.Text (Text) +import Network.HTTP.Req (Option, Scheme (Https), Url, https, (/:), + (=:)) +import Rakuten.Types + +-- | +-- Application ID +type AppId = Text + +type RakutenClient = + Record '[ + "applicationId" ':> Text, + "affiliateId" ':> Maybe Text, + "callback" ':> Maybe Text, + "elements" ':> [Text] + ] + +defaultRaktenClient :: AppId -> RakutenClient +defaultRaktenClient appId = def & #applicationId .~ appId + +-- | +-- By using type class, the same functions can be used for mock servers and local hosts. +class Client a where + type ClientScheme a :: Scheme + baseUrl :: a -> Url (ClientScheme a) + mkHeader :: a -> Option scheme + +instance Client RakutenClient where + type ClientScheme RakutenClient = 'Https + baseUrl = const (https "app.rakuten.co.jp" /: "services" /: "api") + mkHeader = mappend ("format" =: ("json" :: Text)) . toParams
src/Rakuten/Endpoints.hs view
@@ -1,5 +1,6 @@-module Rakuten.Endpoints (- module Rakuten.Endpoints.Ichiba- ) where--import Rakuten.Endpoints.Ichiba+module Rakuten.Endpoints ( + -- Rakuten Ichiba API + module Rakuten.Endpoints.Ichiba + ) where + +import Rakuten.Endpoints.Ichiba
src/Rakuten/Endpoints/Ichiba.hs view
@@ -1,26 +1,37 @@-{-# LANGUAGE OverloadedStrings #-}--module Rakuten.Endpoints.Ichiba- ( searchIchibaItem- , searchIchibaGenre- ) where--import Data.Monoid ((<>))-import Network.HTTP.Req (GET (..), JsonResponse, MonadHttp,- NoReqBody (..), jsonResponse, req, (/:))-import Rakuten.Client-import Rakuten.Types--searchIchibaItem :: (MonadHttp m, Client c) =>- c -> IchibaItemSearchParam -> m (JsonResponse IchibaItems)-searchIchibaItem c param = req GET url NoReqBody jsonResponse option- where- url = baseUrl c /: "IchibaItem" /: "Search" /: "20170706"- option = mkHeader c <> toParams param--searchIchibaGenre :: (MonadHttp m, Client c) =>- c -> IchibaGenreSearchParam -> m (JsonResponse IchibaGenres)-searchIchibaGenre c param = req GET url NoReqBody jsonResponse option- where- url = baseUrl c /: "IchibaGenre" /: "Search" /: "20140222"- option = mkHeader c <> toParams param+-- | +-- see: https://webservice.rakuten.co.jp/document/#ichibaApi + +{-# LANGUAGE OverloadedStrings #-} + +module Rakuten.Endpoints.Ichiba + ( searchIchibaItem + , searchIchibaGenre + ) where + +import Data.Monoid ((<>)) +import Network.HTTP.Req (GET (..), JsonResponse, MonadHttp, + NoReqBody (..), jsonResponse, req, (/:)) +import Rakuten.Client +import Rakuten.Types + +-- | +-- Rakuten Ichiba Item Search API +-- more info: https://webservice.rakuten.co.jp/api/ichibaitemsearch + +searchIchibaItem :: (MonadHttp m, Client c) => + c -> IchibaItemSearchParam -> m (JsonResponse IchibaItems) +searchIchibaItem c param = req GET url NoReqBody jsonResponse option + where + url = baseUrl c /: "IchibaItem" /: "Search" /: "20170706" + option = mkHeader c <> toParams param + +-- | +-- Rakuten Ichiba Genre Search AppId +-- more info: https://webservice.rakuten.co.jp/api/ichibagenresearch + +searchIchibaGenre :: (MonadHttp m, Client c) => + c -> IchibaGenreSearchParam -> m (JsonResponse IchibaGenres) +searchIchibaGenre c param = req GET url NoReqBody jsonResponse option + where + url = baseUrl c /: "IchibaGenre" /: "Search" /: "20140222" + option = mkHeader c <> toParams param
src/Rakuten/Types.hs view
@@ -1,9 +1,8 @@-module Rakuten.Types- ( module Types- ) where---import Rakuten.Types.Base as Types-import Rakuten.Types.Class as Types-import Rakuten.Types.Error as Types-import Rakuten.Types.Ichiba as Types+module Rakuten.Types + ( module Types + ) where + +import Rakuten.Types.Base as Types +import Rakuten.Types.Class as Types +import Rakuten.Types.Error as Types +import Rakuten.Types.Ichiba as Types
src/Rakuten/Types/Base.hs view
@@ -1,13 +1,13 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}--module Rakuten.Types.Base- ( ImageUrl- ) where--import Data.Extensible-import Data.Text (Text)--type ImageUrl = Record '[ "imageUrl" ':> Text ]+{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Rakuten.Types.Base + ( ImageUrl + ) where + +import Data.Extensible +import Data.Text (Text) + +type ImageUrl = Record '[ "imageUrl" ':> Text ]
src/Rakuten/Types/Class.hs view
@@ -1,87 +1,94 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--module Rakuten.Types.Class- ( ToParam(..)- , ToParams(..)- ) where--import Control.Applicative (liftA2)-import Data.Aeson hiding (KeyValue)-import Data.Bool (bool)-import Data.Constraint-import Data.Default.Class (Default (..))-import Data.Extensible-import Data.Functor.Identity (Identity (..))-import qualified Data.HashMap.Strict as HM-import Data.Monoid (Endo (..), (<>))-import Data.Proxy-import Data.String (fromString)-import Data.Text (Text)-import GHC.TypeLits (KnownSymbol, symbolVal)-import Network.HTTP.Req (QueryParam, (=:))--instance Forall (KeyValue KnownSymbol FromJSON) xs => FromJSON (Record xs) where- parseJSON = withObject "Object" $- \v -> hgenerateFor (Proxy :: Proxy (KeyValue KnownSymbol FromJSON)) $- \m -> let k = symbolVal (proxyAssocKey m) in- case HM.lookup (fromString k) v of- Just a -> Field . return <$> parseJSON a- Nothing -> fail $ "Missing key: " `mappend` k--instance Forall (KeyValue KnownSymbol ToJSON) xs => ToJSON (Record xs) where- toJSON = Object . HM.fromList . flip appEndo [] . hfoldMap getConst' . hzipWith- (\(Comp Dict) -> Const' . Endo . (:) .- liftA2 (,) (fromString . symbolVal . proxyAssocKey) (toJSON . getField))- (library :: Comp Dict (KeyValue KnownSymbol ToJSON) :* xs)--instance Default a => Default (Identity a) where- def = Identity def--instance Default Text where- def = mempty--instance Forall (KeyValue KnownSymbol Default) xs => Default (Record xs) where- def = runIdentity $ hgenerateFor- (Proxy :: Proxy (KeyValue KnownSymbol Default)) (const $ pure (Field def))--class ToParam a where- toParam :: (QueryParam param, Monoid param) => Text -> a -> param--instance ToParam Int where- toParam = (=:)--instance ToParam Double where- toParam = (=:)--instance ToParam Text where- toParam _ "" = mempty- toParam name txt = name =: txt--instance ToParam Bool where- toParam name = (=:) name . bool 0 (1 :: Int)--instance ToParam [Text] where- toParam _ [] = mempty- toParam name xs = name =: foldl1 (\acc s -> acc <> "," <> s) (fmap show xs)--instance ToParam a => ToParam (Maybe a) where- toParam = maybe mempty . toParam--instance ToParam a => ToParam (Identity a) where- toParam name = toParam name . runIdentity--class ToParams a where- toParams :: (QueryParam param, Monoid param) => a -> param--instance Forall (KeyValue KnownSymbol ToParam) xs => ToParams (Record xs) where- toParams = flip appEndo mempty . hfoldMap getConst' . hzipWith- (\(Comp Dict) -> Const' . Endo . (<>) .- liftA2 toParam (fromString . symbolVal . proxyAssocKey) getField)- (library :: Comp Dict (KeyValue KnownSymbol ToParam) :* xs)+{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +module Rakuten.Types.Class + ( ToParam(..) + , ToParams(..) + ) where + +import Control.Applicative (liftA2) +import Data.Aeson hiding (KeyValue) +import Data.Bool (bool) +import Data.Constraint +import Data.Default.Class (Default (..)) +import Data.Extensible +import Data.Functor.Identity (Identity (..)) +import qualified Data.HashMap.Strict as HM +import Data.Monoid (Endo (..), (<>)) +import Data.Proxy +import Data.String (fromString) +import Data.Text (Text) +import GHC.TypeLits (KnownSymbol, symbolVal) +import Network.HTTP.Req (QueryParam, (=:)) + +instance Forall (KeyValue KnownSymbol FromJSON) xs => FromJSON (Record xs) where + parseJSON = withObject "Object" $ + \v -> hgenerateFor (Proxy :: Proxy (KeyValue KnownSymbol FromJSON)) $ + \m -> let k = symbolVal (proxyAssocKey m) in + case HM.lookup (fromString k) v of + Just a -> Field . return <$> parseJSON a + Nothing -> fail $ "Missing key: " `mappend` k + +instance Forall (KeyValue KnownSymbol ToJSON) xs => ToJSON (Record xs) where + toJSON = Object . HM.fromList . flip appEndo [] . hfoldMap getConst' . hzipWith + (\(Comp Dict) -> Const' . Endo . (:) . + liftA2 (,) (fromString . symbolVal . proxyAssocKey) (toJSON . getField)) + (library :: Comp Dict (KeyValue KnownSymbol ToJSON) :* xs) + +instance Default a => Default (Identity a) where + def = Identity def + +instance Default Text where + def = mempty + +instance Forall (KeyValue KnownSymbol Default) xs => Default (Record xs) where + def = runIdentity $ hgenerateFor + (Proxy :: Proxy (KeyValue KnownSymbol Default)) (const $ pure (Field def)) + +-- | +-- Helper Type Class of 'QueryParam' + +class ToParam a where + toParam :: (QueryParam param, Monoid param) => Text -> a -> param + +instance ToParam Int where + toParam = (=:) + +instance ToParam Double where + toParam = (=:) + +instance ToParam Text where + toParam _ "" = mempty + toParam name txt = name =: txt + +instance ToParam Bool where + toParam name = (=:) name . bool 0 (1 :: Int) + +instance ToParam [Text] where + toParam _ [] = mempty + toParam name xs = name =: foldl1 (\acc s -> acc <> "," <> s) (fmap show xs) + +instance ToParam a => ToParam (Maybe a) where + toParam = maybe mempty . toParam + +instance ToParam a => ToParam (Identity a) where + toParam name = toParam name . runIdentity + +-- | +-- Helper Type Class of 'QueryParam' +-- use to construct request parameter from param type, e.g. 'IchibaItemSearchParam' + +class ToParams a where + toParams :: (QueryParam param, Monoid param) => a -> param + +instance Forall (KeyValue KnownSymbol ToParam) xs => ToParams (Record xs) where + toParams = flip appEndo mempty . hfoldMap getConst' . hzipWith + (\(Comp Dict) -> Const' . Endo . (<>) . + liftA2 toParam (fromString . symbolVal . proxyAssocKey) getField) + (library :: Comp Dict (KeyValue KnownSymbol ToParam) :* xs)
src/Rakuten/Types/Error.hs view
@@ -1,23 +1,23 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeOperators #-}--module Rakuten.Types.Error- ( RakutenError- ) where--import Data.Extensible-import Data.Text (Text)---- |--- when error, Rakuten is response:--- {--- "error": "wrong_parameter",--- "error_description": "specify valid applicationId"--- }--type RakutenError =- Record '[- "error" ':> Text,- "error_description" ':> Text- ]+{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} + +module Rakuten.Types.Error + ( RakutenError + ) where + +import Data.Extensible +import Data.Text (Text) + +-- | +-- when error, Rakuten is response: +-- { +-- "error": "wrong_parameter", +-- "error_description": "specify valid applicationId" +-- } + +type RakutenError = + Record '[ + "error" ':> Text, + "error_description" ':> Text + ]
src/Rakuten/Types/Ichiba.hs view
@@ -1,226 +1,225 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}--module Rakuten.Types.Ichiba- ( -- Response JSON Type- IchibaItems- , ItemWrap- , Item- , IchibaGenres- -- Genre JSON Type- , Genre- , ParentGenre'- , ParentGenreWrap- , BrotherGenreWrap- , ChiledGenreWrap- , GenreInformation- , CurrentItemGenre- , ChiledItemGenre- -- Tag JSON Type- -- , Tag- , TagWrap- , TagGroup- , TagGroupWrap- , ItemTag- , ItemTagWrap- , ItemTagGroup- , ItemTagGroupWrap- -- Request Params Type- , IchibaItemSearchParam- , IchibaGenreSearchParam- ) where--import Data.Extensible-import Data.Text (Text)-import Rakuten.Types.Base (ImageUrl)-import Rakuten.Types.Class ()--type IchibaItems =- Record '[- "count" ':> Int,- "page" ':> Int,- "first" ':> Int,- "last" ':> Int,- "hits" ':> Int,- "carrier" ':> Int,- "pageCount" ':> Int,- "Items" ':> [ItemWrap],- "GenreInformation" ':> [GenreInformation],- "TagInformation" ':> [ItemTagGroupWrap]- ]--type ItemWrap = Record '[ "Item" ':> Item ]--type Item =- Record '[- "itemName" ':> Text,- "catchcopy" ':> Text,- "itemCode" ':> Text,- "itemPrice" ':> Int,- "itemCaption" ':> Text,- "itemUrl" ':> Text,- "shopUrl" ':> Text,- "smallImageUrls" ':> [ImageUrl],- "mediumImageUrls" ':> [ImageUrl],- "affiliateUrl" ':> Text,- "shopAffiliateUrl" ':> Text,- "imageFlag" ':> Int,- "availability" ':> Int,- "taxFlag" ':> Int,- "postageFlag" ':> Int,- "creditCardFlag" ':> Int,- "shopOfTheYearFlag" ':> Int,- "shipOverseasFlag" ':> Int,- "shipOverseasArea" ':> Text,- "asurakuFlag" ':> Int,- "asurakuClosingTime" ':> Text,- "asurakuArea" ':> Text,- "affiliateRate" ':> Double,- "startTime" ':> Text,- "endTime" ':> Text,- "reviewCount" ':> Int,- "reviewAverage" ':> Double,- "pointRate" ':> Int,- "pointRateStartTime" ':> Text,- "pointRateEndTime" ':> Text,- "giftFlag" ':> Int,- "shopName" ':> Text,- "shopCode" ':> Text,- "genreId" ':> Text,- "tagIds" ':> [Int]- ]--type GenreInformation =- Record '[- "parent" ':> [ParentGenre'],- "current" ':> [CurrentItemGenre],- "chiled" ':> [ChiledItemGenre]- ]--type ParentGenre' =- Record '[- "genreId" ':> Text,- "genreName" ':> Text,- "genreLevel" ':> Int- ]--type CurrentItemGenre =- Record '[- "genreId" ':> Text,- "genreName" ':> Text,- "itemCount" ':> Int,- "genreLevel" ':> Int- ]--type ChiledItemGenre =- Record '[- "genreId" ':> Text,- "genreName" ':> Text,- "itemCount" ':> Int,- "genreLevel" ':> Int- ]--type ItemTagGroupWrap = Record '[ "tagGroup" ':> ItemTagGroup ]--type ItemTagGroup =- Record '[- "tagGroupName" ':> Text,- "tagGroupId" ':> Int,- "tags" ':> [ItemTagWrap]- ]--type ItemTagWrap = Record '[ "tag" ':> ItemTag ]--type ItemTag =- Record '[- "tagId" ':> Int,- "tagName" ':> Text,- "parentTagId" ':> Int,- "itemCount" ':> Int- ]--type IchibaGenres =- Record '[- "parents" ':> [ParentGenreWrap],- "current" ':> Genre,- "brothers" ':> [BrotherGenreWrap],- "children" ':> [ChiledGenreWrap],- "tagGroups" ':> [TagGroupWrap]- ]--type Genre =- Record '[- "genreId" ':> Int,- "genreName" ':> Text,- "genreLevel" ':> Int- ]--type ParentGenreWrap = Record '[ "parent" ':> Genre ]--type BrotherGenreWrap = Record '[ "brother" ':> Genre ]--type ChiledGenreWrap = Record '[ "child" ':> Genre ]--type TagGroupWrap = Record '[ "tagGroup" ':> TagGroup ]--type TagGroup =- Record '[- "tagGroupName" ':> Text,- "tagGroupId" ':> Int,- "tags" ':> [TagWrap]- ]--type TagWrap = Record '[ "tag" ':> Tag ]--type Tag =- Record '[- "tagId" ':> Int,- "tagName" ':> Text,- "parentTagId" ':> Int- ]--type IchibaItemSearchParam =- Record '[- "keyword" ':> Text,- "shopCode" ':> Maybe Text,- "itemCode" ':> Maybe Text,- "genreId" ':> Maybe Int,- "tagId" ':> Maybe Int,- "hits" ':> Maybe Int,- "page" ':> Maybe Int,- "sort" ':> Maybe Text,- "minPrice" ':> Maybe Int,- "maxPrice" ':> Maybe Int,- "availability" ':> Maybe Bool,- "field" ':> Maybe Bool,- "carrier" ':> Maybe Bool,- "imageFlag" ':> Maybe Bool,- "orFlag" ':> Maybe Bool,- "NGKeyword" ':> Maybe Text,- "purchaseType" ':> Maybe Int,- "shipOverseasFlag" ':> Maybe Bool,- "shipOverseasArea" ':> Maybe Text,- "asurakuFlag" ':> Maybe Bool,- "asurakuArea" ':> Maybe Int,- "pointRateFlag" ':> Maybe Bool,- "pointRate" ':> Maybe Int,- "postageFlag" ':> Maybe Bool,- "creditCardFlag" ':> Maybe Bool,- "giftFlag" ':> Maybe Bool,- "hasReviewFlag" ':> Maybe Bool,- "maxAffiliateRate" ':> Maybe Double,- "minAffiliateRate" ':> Maybe Double,- "hasMovieFlag" ':> Maybe Bool,- "pamphletFlag" ':> Maybe Bool,- "appointDeliveryDateFlag" ':> Maybe Bool,- "genreInformationFlag" ':> Maybe Bool,- "tagInformationFlag" ':> Maybe Bool- ]--type IchibaGenreSearchParam =- Record '[- "genreId" ':> Int,- "genrePath" ':> Maybe Bool- ]+{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Rakuten.Types.Ichiba + ( -- Response JSON Type + IchibaItems + , ItemWrap + , Item + , IchibaGenres + -- Genre JSON Type + , Genre + , ParentGenre' + , ParentGenreWrap + , BrotherGenreWrap + , ChiledGenreWrap + , GenreInformation + , CurrentItemGenre + , ChiledItemGenre + -- Tag JSON Type + , TagWrap + , TagGroup + , TagGroupWrap + , ItemTag + , ItemTagWrap + , ItemTagGroup + , ItemTagGroupWrap + -- Request Params Type + , IchibaItemSearchParam + , IchibaGenreSearchParam + ) where + +import Data.Extensible +import Data.Text (Text) +import Rakuten.Types.Base (ImageUrl) +import Rakuten.Types.Class () + +type IchibaItems = + Record '[ + "count" ':> Int, + "page" ':> Int, + "first" ':> Int, + "last" ':> Int, + "hits" ':> Int, + "carrier" ':> Int, + "pageCount" ':> Int, + "Items" ':> [ItemWrap], + "GenreInformation" ':> [GenreInformation], + "TagInformation" ':> [ItemTagGroupWrap] + ] + +type ItemWrap = Record '[ "Item" ':> Item ] + +type Item = + Record '[ + "itemName" ':> Text, + "catchcopy" ':> Text, + "itemCode" ':> Text, + "itemPrice" ':> Int, + "itemCaption" ':> Text, + "itemUrl" ':> Text, + "shopUrl" ':> Text, + "smallImageUrls" ':> [ImageUrl], + "mediumImageUrls" ':> [ImageUrl], + "affiliateUrl" ':> Text, + "shopAffiliateUrl" ':> Text, + "imageFlag" ':> Int, + "availability" ':> Int, + "taxFlag" ':> Int, + "postageFlag" ':> Int, + "creditCardFlag" ':> Int, + "shopOfTheYearFlag" ':> Int, + "shipOverseasFlag" ':> Int, + "shipOverseasArea" ':> Text, + "asurakuFlag" ':> Int, + "asurakuClosingTime" ':> Text, + "asurakuArea" ':> Text, + "affiliateRate" ':> Double, + "startTime" ':> Text, + "endTime" ':> Text, + "reviewCount" ':> Int, + "reviewAverage" ':> Double, + "pointRate" ':> Int, + "pointRateStartTime" ':> Text, + "pointRateEndTime" ':> Text, + "giftFlag" ':> Int, + "shopName" ':> Text, + "shopCode" ':> Text, + "genreId" ':> Text, + "tagIds" ':> [Int] + ] + +type GenreInformation = + Record '[ + "parent" ':> [ParentGenre'], + "current" ':> [CurrentItemGenre], + "chiled" ':> [ChiledItemGenre] + ] + +type ParentGenre' = + Record '[ + "genreId" ':> Text, + "genreName" ':> Text, + "genreLevel" ':> Int + ] + +type CurrentItemGenre = + Record '[ + "genreId" ':> Text, + "genreName" ':> Text, + "itemCount" ':> Int, + "genreLevel" ':> Int + ] + +type ChiledItemGenre = + Record '[ + "genreId" ':> Text, + "genreName" ':> Text, + "itemCount" ':> Int, + "genreLevel" ':> Int + ] + +type ItemTagGroupWrap = Record '[ "tagGroup" ':> ItemTagGroup ] + +type ItemTagGroup = + Record '[ + "tagGroupName" ':> Text, + "tagGroupId" ':> Int, + "tags" ':> [ItemTagWrap] + ] + +type ItemTagWrap = Record '[ "tag" ':> ItemTag ] + +type ItemTag = + Record '[ + "tagId" ':> Int, + "tagName" ':> Text, + "parentTagId" ':> Int, + "itemCount" ':> Int + ] + +type IchibaGenres = + Record '[ + "parents" ':> [ParentGenreWrap], + "current" ':> Genre, + "brothers" ':> [BrotherGenreWrap], + "children" ':> [ChiledGenreWrap], + "tagGroups" ':> [TagGroupWrap] + ] + +type Genre = + Record '[ + "genreId" ':> Int, + "genreName" ':> Text, + "genreLevel" ':> Int + ] + +type ParentGenreWrap = Record '[ "parent" ':> Genre ] + +type BrotherGenreWrap = Record '[ "brother" ':> Genre ] + +type ChiledGenreWrap = Record '[ "child" ':> Genre ] + +type TagGroupWrap = Record '[ "tagGroup" ':> TagGroup ] + +type TagGroup = + Record '[ + "tagGroupName" ':> Text, + "tagGroupId" ':> Int, + "tags" ':> [TagWrap] + ] + +type TagWrap = Record '[ "tag" ':> Tag ] + +type Tag = + Record '[ + "tagId" ':> Int, + "tagName" ':> Text, + "parentTagId" ':> Int + ] + +type IchibaItemSearchParam = + Record '[ + "keyword" ':> Text, + "shopCode" ':> Maybe Text, + "itemCode" ':> Maybe Text, + "genreId" ':> Maybe Int, + "tagId" ':> Maybe Int, + "hits" ':> Maybe Int, + "page" ':> Maybe Int, + "sort" ':> Maybe Text, + "minPrice" ':> Maybe Int, + "maxPrice" ':> Maybe Int, + "availability" ':> Maybe Bool, + "field" ':> Maybe Bool, + "carrier" ':> Maybe Bool, + "imageFlag" ':> Maybe Bool, + "orFlag" ':> Maybe Bool, + "NGKeyword" ':> Maybe Text, + "purchaseType" ':> Maybe Int, + "shipOverseasFlag" ':> Maybe Bool, + "shipOverseasArea" ':> Maybe Text, + "asurakuFlag" ':> Maybe Bool, + "asurakuArea" ':> Maybe Int, + "pointRateFlag" ':> Maybe Bool, + "pointRate" ':> Maybe Int, + "postageFlag" ':> Maybe Bool, + "creditCardFlag" ':> Maybe Bool, + "giftFlag" ':> Maybe Bool, + "hasReviewFlag" ':> Maybe Bool, + "maxAffiliateRate" ':> Maybe Double, + "minAffiliateRate" ':> Maybe Double, + "hasMovieFlag" ':> Maybe Bool, + "pamphletFlag" ':> Maybe Bool, + "appointDeliveryDateFlag" ':> Maybe Bool, + "genreInformationFlag" ':> Maybe Bool, + "tagInformationFlag" ':> Maybe Bool + ] + +type IchibaGenreSearchParam = + Record '[ + "genreId" ':> Int, + "genrePath" ':> Maybe Bool + ]
test/Rakuten/Endpoints/IchibaSpec.hs view
@@ -1,29 +1,29 @@-module Rakuten.Endpoints.IchibaSpec- ( main- , spec- ) where--import Data.Default.Class (Default (def))-import Network.HTTP.Req (responseBody, runReq)-import Rakuten.Endpoints.Ichiba (searchIchibaGenre, searchIchibaItem)-import Rakuten.Test.Class (TestData (..))-import Rakuten.Test.Client (TestClient (..))-import Rakuten.Test.MockServer (runMockServer)-import Test.Hspec (Spec, around_, context, describe,- hspec, it, shouldBe)--main :: IO ()-main = hspec spec--spec :: Spec-spec = around_ runMockServer $ do- describe "searchIchibaItem: endpoint GET /IchibaItem/Search/20170706" $ do- context "correct responce" $ do- it "should return IchibaItems response body" $ do- response <- runReq def $ searchIchibaItem (TestClient def) def- (responseBody response) `shouldBe` testData- describe "searchIchibaGenre: endpoint GET /IchibaGenre/Search/20140222" $ do- context "correct responce" $ do- it "should return IchibaGenres response body" $ do- response <- runReq def $ searchIchibaGenre (TestClient def) def- (responseBody response) `shouldBe` testData+module Rakuten.Endpoints.IchibaSpec + ( main + , spec + ) where + +import Data.Default.Class (Default (def)) +import Network.HTTP.Req (responseBody, runReq) +import Rakuten.Endpoints.Ichiba (searchIchibaGenre, searchIchibaItem) +import Rakuten.Test.Class (TestData (..)) +import Rakuten.Test.Client (TestClient (..)) +import Rakuten.Test.MockServer (runMockServer) +import Test.Hspec (Spec, around_, context, describe, + hspec, it, shouldBe) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = around_ runMockServer $ do + describe "searchIchibaItem: endpoint GET /IchibaItem/Search/20170706" $ do + context "correct responce" $ do + it "should return IchibaItems response body" $ do + response <- runReq def $ searchIchibaItem (TestClient def) def + (responseBody response) `shouldBe` testData + describe "searchIchibaGenre: endpoint GET /IchibaGenre/Search/20140222" $ do + context "correct responce" $ do + it "should return IchibaGenres response body" $ do + response <- runReq def $ searchIchibaGenre (TestClient def) def + (responseBody response) `shouldBe` testData
test/Rakuten/Test/Class.hs view
@@ -1,36 +1,36 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-}--module Rakuten.Test.Class- ( TestData(..)- ) where--import Data.Extensible-import Data.Functor.Identity (Identity (..))-import Data.Proxy-import Data.Text (Text)-import GHC.TypeLits (KnownSymbol)--class TestData a where- testData :: a--instance TestData Int where- testData = 12345--instance TestData Double where- testData = 123.456--instance TestData Text where- testData = "abcdefg"--instance TestData Bool where- testData = False--instance (Applicative m, TestData a) => TestData (m a) where- testData = pure testData--instance Forall (KeyValue KnownSymbol TestData) xs => TestData (Record xs) where- testData = runIdentity $ hgenerateFor- (Proxy :: Proxy (KeyValue KnownSymbol TestData)) (const $ pure (Field testData))+{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Rakuten.Test.Class + ( TestData(..) + ) where + +import Data.Extensible +import Data.Functor.Identity (Identity (..)) +import Data.Proxy +import Data.Text (Text) +import GHC.TypeLits (KnownSymbol) + +class TestData a where + testData :: a + +instance TestData Int where + testData = 12345 + +instance TestData Double where + testData = 123.456 + +instance TestData Text where + testData = "abcdefg" + +instance TestData Bool where + testData = False + +instance (Applicative m, TestData a) => TestData (m a) where + testData = pure testData + +instance Forall (KeyValue KnownSymbol TestData) xs => TestData (Record xs) where + testData = runIdentity $ hgenerateFor + (Proxy :: Proxy (KeyValue KnownSymbol TestData)) (const $ pure (Field testData))
test/Rakuten/Test/Client.hs view
@@ -1,20 +1,20 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}--module Rakuten.Test.Client (- TestClient(..)- ) where--import Data.Text (Text)-import Network.HTTP.Req (Scheme (Http), http, port, (=:))-import Rakuten.Client (Client (..), RakutenClient)-import Rakuten.Types (ToParams (toParams))--newtype TestClient = TestClient RakutenClient--instance Client TestClient where- type ClientScheme TestClient = 'Http- baseUrl = const (http "localhost")- mkHeader (TestClient c) =- mconcat [port 8000, "format" =: ("json" :: Text), toParams c]+{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +module Rakuten.Test.Client ( + TestClient(..) + ) where + +import Data.Text (Text) +import Network.HTTP.Req (Scheme (Http), http, port, (=:)) +import Rakuten.Client (Client (..), RakutenClient) +import Rakuten.Types (ToParams (toParams)) + +newtype TestClient = TestClient RakutenClient + +instance Client TestClient where + type ClientScheme TestClient = 'Http + baseUrl = const (http "localhost") + mkHeader (TestClient c) = + mconcat [port 8000, "format" =: ("json" :: Text), toParams c]
test/Rakuten/Test/MockServer.hs view
@@ -1,41 +1,41 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--{-# OPTIONS_GHC -fno-warn-unused-binds #-}--module Rakuten.Test.MockServer- ( mockServer- , runMockServer- ) where--import Rakuten.Test.Class-import Rakuten.Types-import Control.Concurrent-import Control.Exception-import Network.Wai.Handler.Warp-import Servant--type RakutenHeader a = a--type API = "IchibaItem" :> "Search" :> "20170706" :> Get '[JSON] (RakutenHeader IchibaItems)- :<|> "IchibaGenre" :> "Search" :> "20140222" :> Get '[JSON] (RakutenHeader IchibaGenres)--api :: Proxy API-api = Proxy--server :: Server API-server = searchIchibaItem- :<|> searchIchibaGenre- where- searchIchibaItem = return testData- searchIchibaGenre = return testData--mockServer :: IO ()-mockServer = run 8000 (serve api server)--runMockServer :: IO () -> IO ()-runMockServer action = do- tid <- forkIO mockServer- action `finally` killThread tid+{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -fno-warn-unused-binds #-} + +module Rakuten.Test.MockServer + ( mockServer + , runMockServer + ) where + +import Rakuten.Test.Class +import Rakuten.Types +import Control.Concurrent +import Control.Exception +import Network.Wai.Handler.Warp +import Servant + +type RakutenHeader a = a + +type API = "IchibaItem" :> "Search" :> "20170706" :> Get '[JSON] (RakutenHeader IchibaItems) + :<|> "IchibaGenre" :> "Search" :> "20140222" :> Get '[JSON] (RakutenHeader IchibaGenres) + +api :: Proxy API +api = Proxy + +server :: Server API +server = searchIchibaItem + :<|> searchIchibaGenre + where + searchIchibaItem = return testData + searchIchibaGenre = return testData + +mockServer :: IO () +mockServer = run 8000 (serve api server) + +runMockServer :: IO () -> IO () +runMockServer action = do + tid <- forkIO mockServer + action `finally` killThread tid
test/Spec.hs view
@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}