rakuten 0.1.1.1 → 0.1.1.2
raw patch · 16 files changed
+614/−614 lines, 16 filesdep ~req
Dependency ranges changed: req
Files
- LICENSE +21/−21
- rakuten.cabal +5/−5
- src/Rakuten.hs +15/−15
- src/Rakuten/Client.hs +52/−52
- src/Rakuten/Endpoints.hs +6/−6
- src/Rakuten/Endpoints/Ichiba.hs +37/−37
- src/Rakuten/Types.hs +8/−8
- src/Rakuten/Types/Base.hs +12/−12
- src/Rakuten/Types/Class.hs +77/−77
- src/Rakuten/Types/Error.hs +23/−23
- src/Rakuten/Types/Ichiba.hs +224/−224
- test/Rakuten/Endpoints/IchibaSpec.hs +24/−24
- test/Rakuten/Test/Class.hs +37/−37
- test/Rakuten/Test/Client.hs +20/−20
- test/Rakuten/Test/MockServer.hs +40/−40
- test/Spec.hs +13/−13
LICENSE view
@@ -1,21 +1,21 @@-MIT License - -Copyright (c) 2017-2018 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-2018 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
@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: 1eebe68d72343d06d49005f2fc2ab80e151fce80350cecaa8233b77affd50a96+-- hash: 7b16ada2700c7bf12480486d74442a8e5f044b80e268540524d07cc87b672644 name: rakuten-version: 0.1.1.1+version: 0.1.1.2 synopsis: The Rakuten API in Haskell description: See README at <https://github.com/matsubara0507/rakuten#readme> category: Web@@ -40,7 +40,7 @@ , http-client-tls >=0.3.3.1 && <0.4 , http-types >=0.9.1 && <0.13 , lens >=4.15.3 && <5.0- , req >=0.3.0 && <1.1.0+ , req >=0.3.0 && <1.2.0 , text >=1.2.2.1 && <1.3 exposed-modules: Rakuten@@ -77,7 +77,7 @@ , http-client-tls >=0.3.3.1 && <0.4 , http-types >=0.9.1 && <0.13 , lens >=4.15.3 && <5.0- , req >=0.3.0 && <1.1.0+ , req >=0.3.0 && <1.2.0 , servant-server >=0.9.1.1 && <0.14 , text >=1.2.2.1 && <1.3 , warp >=3.2.11 && <3.3
src/Rakuten.hs view
@@ -1,15 +1,15 @@--- | --- 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 +-- |+-- 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,52 +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 - --- | --- 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 +{-# 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,6 +1,6 @@-module Rakuten.Endpoints ( - -- Rakuten Ichiba API - 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,37 +1,37 @@--- | --- 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 +-- |+-- 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,8 +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,12 +1,12 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# 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 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,77 +1,77 @@-{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Rakuten.Types.Class - ( ToParam(..) - , ToParams(..) - ) where - -import Control.Applicative (liftA2) -import Data.Bool (bool) -import Data.Constraint -import Data.Default.Class (Default (..)) -import Data.Extensible -import Data.Functor.Identity (Identity (..)) -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 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) +{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Rakuten.Types.Class+ ( ToParam(..)+ , ToParams(..)+ ) where++import Control.Applicative (liftA2)+import Data.Bool (bool)+import Data.Constraint+import Data.Default.Class (Default (..))+import Data.Extensible+import Data.Functor.Identity (Identity (..))+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 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,224 +1,224 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# 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 - ] +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# 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,24 +1,24 @@-module Rakuten.Endpoints.IchibaSpec - ( 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 Test.Hspec (Spec, context, describe, it, - shouldBe) - -spec :: Spec -spec = 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+ ( 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 Test.Hspec (Spec, context, describe, it,+ shouldBe)++spec :: Spec+spec = 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,37 +1,37 @@-{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# 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 MultiParamTypeClasses #-}+{-# 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,40 +1,40 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -{-# OPTIONS_GHC -fno-warn-unused-binds #-} - -module Rakuten.Test.MockServer - ( mockServer - , runMockServer - ) where - -import Control.Concurrent -import Network.Wai.Handler.Warp -import Rakuten.Test.Class -import Rakuten.Types -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 - _ <- forkIO mockServer - action +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++{-# OPTIONS_GHC -fno-warn-unused-binds #-}++module Rakuten.Test.MockServer+ ( mockServer+ , runMockServer+ ) where++import Control.Concurrent+import Network.Wai.Handler.Warp+import Rakuten.Test.Class+import Rakuten.Types+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+ _ <- forkIO mockServer+ action
test/Spec.hs view
@@ -1,13 +1,13 @@-module Main where - -import Test.Hspec - -import qualified Rakuten.Endpoints.IchibaSpec -import Rakuten.Test.MockServer (runMockServer) - -main :: IO () -main = hspec spec - -spec :: Spec -spec = around_ runMockServer $ do - describe "Rakuten.Endpoints.Ichiba" Rakuten.Endpoints.IchibaSpec.spec +module Main where++import Test.Hspec++import qualified Rakuten.Endpoints.IchibaSpec+import Rakuten.Test.MockServer (runMockServer)++main :: IO ()+main = hspec spec++spec :: Spec+spec = around_ runMockServer $ do+ describe "Rakuten.Endpoints.Ichiba" Rakuten.Endpoints.IchibaSpec.spec