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