diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/rakuten.cabal b/rakuten.cabal --- a/rakuten.cabal +++ b/rakuten.cabal @@ -1,11 +1,11 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack -- --- hash: 87449ecc98455de4163fff1afd3f2b3b599244a492f29b58b4c12d2d1b83e8d0 +-- hash: 586e0f5440a5dc6bb820a557f51b7d248f3938d96631e572ae811354e6266972 name: rakuten -version: 0.1.1.3 +version: 0.1.1.4 synopsis: The Rakuten API in Haskell description: See README at category: Web @@ -28,13 +28,13 @@ src ghc-options: -Wall build-depends: - aeson >=1.0.2.1 && <1.4 + aeson >=1.0.2.1 && <1.5 , base >=4.7 && <5 , bytestring >=0.10.8.1 && <0.11 , connection >=0.2.7 && <0.3 , constraints >=0.9.1 && <0.11 , data-default-class >=0.1.2.0 && <0.2 - , extensible >=0.4.7.2 && <0.4.10 + , extensible >=0.4.7.2 && <0.4.11 , http-api-data >=0.3.5 && <0.3.9 , http-client >=0.5.5.0 && <0.6 , http-client-tls >=0.3.3.1 && <0.4 @@ -64,13 +64,13 @@ src ghc-options: -Wall build-depends: - aeson >=1.0.2.1 && <1.4 + aeson >=1.0.2.1 && <1.5 , base >=4.7 && <5 , bytestring >=0.10.8.1 && <0.11 , connection >=0.2.7 && <0.3 , constraints >=0.9.1 && <0.11 , data-default-class >=0.1.2.0 && <0.2 - , extensible >=0.4.7.2 && <0.4.10 + , extensible >=0.4.7.2 && <0.4.11 , hspec >=2.4.1 && <2.6 , http-api-data >=0.3.5 && <0.3.9 , http-client >=0.5.5.0 && <0.6 @@ -78,7 +78,7 @@ , http-types >=0.9.1 && <0.13 , lens >=4.15.3 && <5.0 , req >=0.3.0 && <1.2.0 - , servant-server >=0.9.1.1 && <0.14 + , servant-server >=0.9.1.1 && <0.15 , text >=1.2.2.1 && <1.3 , warp >=3.2.11 && <3.3 other-modules: diff --git a/src/Rakuten.hs b/src/Rakuten.hs --- a/src/Rakuten.hs +++ b/src/Rakuten.hs @@ -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 diff --git a/src/Rakuten/Client.hs b/src/Rakuten/Client.hs --- a/src/Rakuten/Client.hs +++ b/src/Rakuten/Client.hs @@ -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 diff --git a/src/Rakuten/Endpoints.hs b/src/Rakuten/Endpoints.hs --- a/src/Rakuten/Endpoints.hs +++ b/src/Rakuten/Endpoints.hs @@ -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 diff --git a/src/Rakuten/Endpoints/Ichiba.hs b/src/Rakuten/Endpoints/Ichiba.hs --- a/src/Rakuten/Endpoints/Ichiba.hs +++ b/src/Rakuten/Endpoints/Ichiba.hs @@ -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 diff --git a/src/Rakuten/Types.hs b/src/Rakuten/Types.hs --- a/src/Rakuten/Types.hs +++ b/src/Rakuten/Types.hs @@ -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 diff --git a/src/Rakuten/Types/Base.hs b/src/Rakuten/Types/Base.hs --- a/src/Rakuten/Types/Base.hs +++ b/src/Rakuten/Types/Base.hs @@ -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 ] diff --git a/src/Rakuten/Types/Class.hs b/src/Rakuten/Types/Class.hs --- a/src/Rakuten/Types/Class.hs +++ b/src/Rakuten/Types/Class.hs @@ -1,77 +1,80 @@ -{-# 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 CPP #-} +{-# 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 (..), (<>)) +#if !MIN_VERSION_extensible(0,4,10) +import Data.Proxy +#endif +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) diff --git a/src/Rakuten/Types/Error.hs b/src/Rakuten/Types/Error.hs --- a/src/Rakuten/Types/Error.hs +++ b/src/Rakuten/Types/Error.hs @@ -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 + ] diff --git a/src/Rakuten/Types/Ichiba.hs b/src/Rakuten/Types/Ichiba.hs --- a/src/Rakuten/Types/Ichiba.hs +++ b/src/Rakuten/Types/Ichiba.hs @@ -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 + ] diff --git a/test/Rakuten/Endpoints/IchibaSpec.hs b/test/Rakuten/Endpoints/IchibaSpec.hs --- a/test/Rakuten/Endpoints/IchibaSpec.hs +++ b/test/Rakuten/Endpoints/IchibaSpec.hs @@ -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 diff --git a/test/Rakuten/Test/Class.hs b/test/Rakuten/Test/Class.hs --- a/test/Rakuten/Test/Class.hs +++ b/test/Rakuten/Test/Class.hs @@ -1,37 +1,40 @@ -{-# 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 CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Rakuten.Test.Class + ( TestData(..) + ) where + +import Data.Extensible +import Data.Functor.Identity (Identity (..)) +#if !MIN_VERSION_extensible(0,4,10) +import Data.Proxy +#endif +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)) diff --git a/test/Rakuten/Test/Client.hs b/test/Rakuten/Test/Client.hs --- a/test/Rakuten/Test/Client.hs +++ b/test/Rakuten/Test/Client.hs @@ -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] diff --git a/test/Rakuten/Test/MockServer.hs b/test/Rakuten/Test/MockServer.hs --- a/test/Rakuten/Test/MockServer.hs +++ b/test/Rakuten/Test/MockServer.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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