rakuten 0.1.1.2 → 0.1.1.3

raw patch · 16 files changed

+614/−614 lines, 16 filesdep ~extensible

Dependency ranges changed: extensible

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.28.2.+-- This file has been generated from package.yaml by hpack version 0.28.2.
 -- -- see: https://github.com/sol/hpack ----- hash: 7b16ada2700c7bf12480486d74442a8e5f044b80e268540524d07cc87b672644+-- hash: 87449ecc98455de4163fff1afd3f2b3b599244a492f29b58b4c12d2d1b83e8d0  name:           rakuten-version:        0.1.1.2+version:        0.1.1.3 synopsis:       The Rakuten API in Haskell description:    See README at <https://github.com/matsubara0507/rakuten#readme> category:       Web@@ -34,7 +34,7 @@     , 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.9+    , extensible >=0.4.7.2 && <0.4.10     , 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@@ -70,7 +70,7 @@     , 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.9+    , extensible >=0.4.7.2 && <0.4.10     , hspec >=2.4.1 && <2.6     , http-api-data >=0.3.5 && <0.3.9     , http-client >=0.5.5.0 && <0.6

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