-
Notifications
You must be signed in to change notification settings - Fork 48
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
4 changed files
with
40 additions
and
73 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,95 +1,65 @@ | ||
| {-# LANGUAGE CPP #-} | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE DeriveFoldable #-} | ||
| {-# LANGUAGE DeriveFunctor #-} | ||
| {-# LANGUAGE DeriveGeneric #-} | ||
| {-# LANGUAGE DeriveTraversable #-} | ||
| {-# LANGUAGE EmptyDataDecls #-} | ||
| {-# LANGUAGE KindSignatures #-} | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
|
|
||
| module Web.Twitter.Conduit.Cursor ( | ||
| CursorKey (..), | ||
| IdsCursorKey, | ||
| UsersCursorKey, | ||
| ListsCursorKey, | ||
| EventsCursorKey, | ||
| WithCursor (..), | ||
| ) where | ||
|
|
||
| -- import Control.DeepSeq (NFData) | ||
| import Data.Aeson | ||
| import Data.Text (Text) | ||
| import Data.Proxy (Proxy (..)) | ||
| import Data.String | ||
| import GHC.Generics | ||
| import Web.Twitter.Types (checkError) | ||
| import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) | ||
|
|
||
| -- $setup | ||
| -- >>> import Data.Text | ||
| -- >>> type UserId = Integer | ||
|
|
||
| {- ORMOLU_DISABLE -} | ||
| class CursorKey a where | ||
| #if MIN_VERSION_aeson(2, 0, 0) | ||
| cursorKey :: a -> Key | ||
| #else | ||
| cursorKey :: a -> Text | ||
| #endif | ||
| {- ORMOLU_ENABLE -} | ||
|
|
||
| -- | Phantom type to specify the key which point out the content in the response. | ||
| data IdsCursorKey | ||
|
|
||
| instance CursorKey IdsCursorKey where | ||
| cursorKey = const "ids" | ||
|
|
||
| -- | Phantom type to specify the key which point out the content in the response. | ||
| data UsersCursorKey | ||
|
|
||
| instance CursorKey UsersCursorKey where | ||
| cursorKey = const "users" | ||
|
|
||
| -- | Phantom type to specify the key which point out the content in the response. | ||
| data ListsCursorKey | ||
|
|
||
| instance CursorKey ListsCursorKey where | ||
| cursorKey = const "lists" | ||
|
|
||
| data EventsCursorKey | ||
| instance CursorKey EventsCursorKey where | ||
| cursorKey = const "events" | ||
|
|
||
| -- | A wrapper for API responses which have "next_cursor" field. | ||
| -- | ||
| -- The first type parameter of 'WithCursor' specifies the field name of contents. | ||
| -- | ||
| -- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 1234567890, \"ids\": [1111111111]}" :: Maybe (WithCursor Integer IdsCursorKey UserId) | ||
| -- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 1234567890, \"ids\": [1111111111]}" :: Maybe (WithCursor Integer "ids" UserId) | ||
| -- >>> nextCursor res | ||
| -- Just 1234567890 | ||
| -- >>> contents res | ||
| -- [1111111111] | ||
| -- | ||
| -- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 0, \"users\": [1000]}" :: Maybe (WithCursor Integer UsersCursorKey UserId) | ||
| -- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 0, \"users\": [1000]}" :: Maybe (WithCursor Integer "users" UserId) | ||
| -- >>> nextCursor res | ||
| -- Just 0 | ||
| -- >>> contents res | ||
| -- [1000] | ||
| -- | ||
| -- >>> let Just res = decode "{\"next_cursor\": \"hogehoge\", \"events\": [1000]}" :: Maybe (WithCursor Text EventsCursorKey UserId) | ||
| -- >>> let Just res = decode "{\"next_cursor\": \"hogehoge\", \"events\": [1000]}" :: Maybe (WithCursor Text "events" UserId) | ||
| -- >>> nextCursor res | ||
| -- Just "hogehoge" | ||
| -- >>> contents res | ||
| -- [1000] | ||
| data WithCursor cursorType cursorKey wrapped = WithCursor | ||
| data WithCursor cursorType (cursorKey :: Symbol) wrapped = WithCursor | ||
| { previousCursor :: Maybe cursorType | ||
| , nextCursor :: Maybe cursorType | ||
| , contents :: [wrapped] | ||
| } | ||
| deriving (Show, Eq, Generic, Functor, Foldable, Traversable) | ||
| deriving (Show, Eq, Generic, Generic1, Functor, Foldable, Traversable) | ||
|
|
||
| instance (KnownSymbol cursorKey, FromJSON cursorType) => FromJSON1 (WithCursor cursorType cursorKey) where | ||
| liftParseJSON _ lp = | ||
| withObject ("WithCursor \"" ++ cursorKeyStr ++ "\"") $ \obj -> | ||
| WithCursor <$> obj .:? "previous_cursor" | ||
| <*> obj .:? "next_cursor" | ||
| <*> (obj .: fromString cursorKeyStr >>= lp) | ||
| where | ||
| cursorKeyStr = symbolVal (Proxy :: Proxy cursorKey) | ||
|
|
||
| instance (KnownSymbol cursorKey, FromJSON cursorType, FromJSON wrapped) => FromJSON (WithCursor cursorType cursorKey wrapped) where | ||
| parseJSON = parseJSON1 | ||
|
|
||
| instance | ||
| (FromJSON wrapped, FromJSON ct, CursorKey c) => | ||
| FromJSON (WithCursor ct c wrapped) | ||
| where | ||
| parseJSON (Object o) = | ||
| checkError o | ||
| >> WithCursor <$> o .:? "previous_cursor" | ||
| <*> o .:? "next_cursor" | ||
| <*> o .: cursorKey (undefined :: c) | ||
| parseJSON _ = mempty | ||
| -- instance NFData a => NFData (WithCursor cursorType cursorKey wrapped) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters