Merge pull request #65 from himura/follow-direct-message-api-chage

Follow direct message API chage

ChangeLog.md

@@ -1,3 +1,9 @@
+## 0.4.0 (wip)
+
+* Changed WithCursor type
+    * Added type parameter to WithCursor to supports `Text` as the next cursor type.
+    * Changed {previous,next}Cursor in WithCursor to be optional
+
 ## 0.3.0
 
 * Upgrade http-conduit dependencies to:

Web/Twitter/Conduit/Base.hs

@@ -1,10 +1,14 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Web.Twitter.Conduit.Base
-       ( getResponse
+       ( ResponseBodyType (..)
+       , NoContent
+       , getResponse
        , call
        , call'
        , callWithResponse
@@ -30,6 +34,7 @@ import Web.Twitter.Conduit.Types
 import Web.Twitter.Types.Lens
 
 import Control.Lens
+import Control.Monad (void)
 import Control.Monad.Base
 import Control.Monad.Catch (MonadThrow (..))
 import Control.Monad.IO.Class
@@ -51,13 +56,19 @@ import Web.Authenticate.OAuth (signOAuth)
 
 makeRequest :: APIRequest apiName responseType
             -> IO HTTP.Request
-makeRequest (APIRequestGet u pa) = makeRequest' "GET" u (makeSimpleQuery pa)
-makeRequest (APIRequestPost u pa) = makeRequest' "POST" u (makeSimpleQuery pa)
-makeRequest (APIRequestPostMultipart u param prt) =
-    formDataBody body =<< makeRequest' "POST" u []
+makeRequest (APIRequest m u pa) = makeRequest' m u (makeSimpleQuery pa)
+makeRequest (APIRequestMultipart m u param prt) =
+    formDataBody body =<< makeRequest' m u []
   where
     body = prt ++ partParam
     partParam = Prelude.map (uncurry partBS . over _1 T.decodeUtf8) (makeSimpleQuery param)
+makeRequest (APIRequestJSON m u param body) = do
+    req <- makeRequest' m u (makeSimpleQuery param)
+    return $
+        req
+        { HTTP.requestBody = HTTP.RequestBodyLBS $ encode body
+        , HTTP.requestHeaders = ("Content-Type", "application/json") : HTTP.requestHeaders req
+        }
 
 makeRequest' :: HT.Method -- ^ HTTP request method (GET or POST)
              -> String -- ^ API Resource URL
@@ -79,6 +90,27 @@ makeRequest' m url query = do
 #endif
                              }
 
+class ResponseBodyType a where
+    parseResponseBody ::
+#if MIN_VERSION_http_conduit(2,3,0)
+           Response (C.ConduitM () ByteString (ResourceT IO) ())
+#else
+           Response (C.ResumableSource m ByteString)
+#endif
+        -> ResourceT IO (Response a)
+
+type NoContent = ()
+instance ResponseBodyType NoContent where
+    parseResponseBody res =
+        case responseStatus res of
+            st | st == HT.status204 -> return $ void res
+            _ -> do
+                body <- C.runConduit $ responseBody res C..| sinkJSON
+                throwM $ TwitterStatusError (responseStatus res) (responseHeaders res) body
+
+instance {-# OVERLAPPABLE #-} FromJSON a => ResponseBodyType a where
+    parseResponseBody = getValueOrThrow
+
 getResponse :: MonadResource m
             => TWInfo
             -> HTTP.Manager
@@ -161,7 +193,7 @@ getValueOrThrow res = do
 --
 -- If you need raw JSON value which is parsed by <http://hackage.haskell.org/package/aeson aeson>,
 -- use 'call'' to obtain it.
-call :: FromJSON responseType
+call :: ResponseBodyType responseType
      => TWInfo -- ^ Twitter Setting
      -> HTTP.Manager
      -> APIRequest apiName responseType
@@ -171,7 +203,7 @@ call = call'
 -- | Perform an 'APIRequest' and then provide the response.
 -- The response of this function is not restrict to @responseType@,
 -- so you can choose an arbitrarily type of FromJSON instances.
-call' :: FromJSON value
+call' :: ResponseBodyType value
       => TWInfo -- ^ Twitter Setting
       -> HTTP.Manager
       -> APIRequest apiName responseType
@@ -188,7 +220,7 @@ call' info mgr req = responseBody `fmap` callWithResponse' info mgr req
 -- 'print' $ 'responseHeaders' res
 -- 'print' $ 'responseBody' res
 -- @
-callWithResponse :: FromJSON responseType
+callWithResponse :: ResponseBodyType responseType
                  => TWInfo -- ^ Twitter Setting
                  -> HTTP.Manager
                  -> APIRequest apiName responseType
@@ -207,15 +239,15 @@ callWithResponse = callWithResponse'
 -- 'print' $ 'responseHeaders' res
 -- 'print' $ 'responseBody' (res :: Value)
 -- @
-callWithResponse' :: FromJSON value
+callWithResponse' :: ResponseBodyType value
                   => TWInfo
                   -> HTTP.Manager
                   -> APIRequest apiName responseType
                   -> IO (Response value)
 callWithResponse' info mgr req =
     runResourceT $ do
         res <- getResponse info mgr =<< liftIO (makeRequest req)
-        getValueOrThrow res
+        parseResponseBody res
 
 -- | A wrapper function to perform multiple API request with changing @max_id@ parameter.
 --
@@ -269,16 +301,17 @@ sourceWithMaxId' info mgr = loop
 sourceWithCursor :: ( MonadIO m
                     , FromJSON responseType
                     , CursorKey ck
-                    , HasCursorParam (APIRequest apiName (WithCursor ck responseType))
+                    , HasCursorParam (APIRequest apiName (WithCursor Integer ck responseType)) Integer
                     )
                  => TWInfo -- ^ Twitter Setting
                  -> HTTP.Manager
-                 -> APIRequest apiName (WithCursor ck responseType)
+                 -> APIRequest apiName (WithCursor Integer ck responseType)
                  -> C.Source m responseType
-sourceWithCursor info mgr req = loop (-1)
+sourceWithCursor info mgr req = loop (Just (-1))
   where
-    loop 0 = CL.sourceNull
-    loop cur = do
+    loop Nothing = CL.sourceNull
+    loop (Just 0) = CL.sourceNull
+    loop (Just cur) = do
         res <- liftIO $ call info mgr $ req & cursor ?~ cur
         CL.sourceList $ contents res
         loop $ nextCursor res
@@ -290,19 +323,20 @@ sourceWithCursor info mgr req = loop (-1)
 -- This function cooperate with instances of 'HasCursorParam'.
 sourceWithCursor' :: ( MonadIO m
                      , CursorKey ck
-                     , HasCursorParam (APIRequest apiName (WithCursor ck responseType))
+                     , HasCursorParam (APIRequest apiName (WithCursor Integer ck responseType)) Integer
                      )
                   => TWInfo -- ^ Twitter Setting
                   -> HTTP.Manager
-                  -> APIRequest apiName (WithCursor ck responseType)
+                  -> APIRequest apiName (WithCursor Integer ck responseType)
                   -> C.Source m Value
-sourceWithCursor' info mgr req = loop (-1)
+sourceWithCursor' info mgr req = loop (Just (-1))
   where
-    relax :: APIRequest apiName (WithCursor ck responseType)
-          -> APIRequest apiName (WithCursor ck Value)
+    relax :: APIRequest apiName (WithCursor Integer ck responseType)
+          -> APIRequest apiName (WithCursor Integer ck Value)
     relax = unsafeCoerce
-    loop 0 = CL.sourceNull
-    loop cur = do
+    loop Nothing = CL.sourceNull
+    loop (Just 0) = CL.sourceNull
+    loop (Just cur) = do
         res <- liftIO $ call info mgr $ relax $ req & cursor ?~ cur
         CL.sourceList $ contents res
         loop $ nextCursor res

Web/Twitter/Conduit/Cursor.hs

@@ -8,6 +8,7 @@ module Web.Twitter.Conduit.Cursor
        , IdsCursorKey
        , UsersCursorKey
        , ListsCursorKey
+       , EventsCursorKey
        , WithCursor (..)
        ) where
 
@@ -40,33 +41,43 @@ data ListsCursorKey
 instance CursorKey ListsCursorKey where
     cursorKey = const "lists"
 
+data EventsCursorKey
+instance CursorKey EventsCursorKey where
+    cursorKey = const "events"
+
 #if __GLASGOW_HASKELL__ >= 706
 -- | 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 IdsCursorKey UserId)
+-- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 1234567890, \"ids\": [1111111111]}" :: Maybe (WithCursor Integer IdsCursorKey UserId)
 -- >>> nextCursor res
--- 1234567890
+-- Just 1234567890
 -- >>> contents res
 -- [1111111111]
 --
--- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 0, \"users\": [1000]}" :: Maybe (WithCursor UsersCursorKey UserId)
+-- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 0, \"users\": [1000]}" :: Maybe (WithCursor Integer UsersCursorKey UserId)
+-- >>> nextCursor res
+-- Just 0
+-- >>> contents res
+-- [1000]
+--
+-- >>> let Just res = decode "{\"next_cursor\": \"hogehoge\", \"events\": [1000]}" :: Maybe (WithCursor Text EventsCursorKey UserId)
 -- >>> nextCursor res
--- 0
+-- Just "hogehoge"
 -- >>> contents res
 -- [1000]
 #endif
-data WithCursor cursorKey wrapped = WithCursor
-    { previousCursor :: Integer
-    , nextCursor :: Integer
+data WithCursor cursorType cursorKey wrapped = WithCursor
+    { previousCursor :: Maybe cursorType
+    , nextCursor :: Maybe cursorType
     , contents :: [wrapped]
     } deriving Show
 
-instance (FromJSON wrapped, CursorKey c) =>
-         FromJSON (WithCursor c wrapped) where
+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"
+      WithCursor <$> o .:? "previous_cursor"
+                 <*> o .:? "next_cursor"
                  <*> o .:  cursorKey (undefined :: c)
     parseJSON _ = mempty

Web/Twitter/Conduit/Lens.hs

@@ -55,11 +55,11 @@ twitterErrorMessage :: Lens' TT.TwitterErrorMessage Text
 twitterErrorMessage afb s = (\b -> s { TT.twitterErrorMessage = b }) <$> afb (TT.twitterErrorMessage s)
 
 -- * Lenses for 'TT.WithCursor'
-previousCursor :: forall cursorKey wrapped. Lens' (TT.WithCursor cursorKey wrapped) Integer
+previousCursor :: forall cursorType cursorKey wrapped. Lens' (TT.WithCursor cursorType cursorKey wrapped) (Maybe cursorType)
 previousCursor afb s = (\b -> s { TT.previousCursor = b }) <$> afb (TT.previousCursor s)
 
-nextCursor :: forall cursorKey wrapped. Lens' (TT.WithCursor cursorKey wrapped) Integer
+nextCursor :: forall cursorType cursorKey wrapped. Lens' (TT.WithCursor cursorType cursorKey wrapped) (Maybe cursorType)
 nextCursor afb s = (\b -> s { TT.nextCursor = b }) <$> afb (TT.nextCursor s)
 
-contents :: forall cursorKey a b. Lens (TT.WithCursor cursorKey a) (TT.WithCursor cursorKey b) [a] [b]
+contents :: forall cursorType cursorKey a b. Lens (TT.WithCursor cursorType cursorKey a) (TT.WithCursor cursorType cursorKey b) [a] [b]
 contents afb s = (\b -> s { TT.contents = b }) <$> afb (TT.contents s)

Web/Twitter/Conduit/Parameters.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -53,6 +54,7 @@ module Web.Twitter.Conduit.Parameters
        , mkListParam
        ) where
 
+import Control.Lens
 import qualified Data.Text as T
 import Network.HTTP.Client (RequestBody)
 import Web.Twitter.Conduit.Parameters.TH
@@ -72,7 +74,6 @@ defineHasParamClassInteger "count"
 defineHasParamClassInteger "since_id"
 defineHasParamClassInteger "max_id"
 defineHasParamClassInteger "page"
-defineHasParamClassInteger "cursor"
 defineHasParamClassBool "trim_user"
 defineHasParamClassBool "exclude_replies"
 defineHasParamClassBool "contributor_details"
@@ -104,6 +105,9 @@ defineHasParamClassURI "url"
 defineHasParamClassBool "full_text"
 defineHasParamClassString "with"
 
+class Parameters p => HasCursorParam p a | p -> a where
+    cursor :: Lens' p (Maybe a)
+
 -- | converts 'UserParam' to 'HT.SimpleQuery'.
 --
 -- >>> makeSimpleQuery . mkUserParam $ UserIdParam 123456

Web/Twitter/Conduit/Parameters/TH.hs

@@ -14,6 +14,7 @@ module Web.Twitter.Conduit.Parameters.TH
        , defineHasParamClassStringArray
        , defineHasParamClassURI
        , deriveHasParamInstances
+       , wrappedParam
        ) where
 
 import Web.Twitter.Conduit.Request

Web/Twitter/Conduit/Request.hs

@@ -16,6 +16,7 @@ module Web.Twitter.Conduit.Request
 import Control.Applicative
 #endif
 import Control.Lens
+import Data.Aeson
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as S8
 import Data.Text (Text)
@@ -41,7 +42,7 @@ class Parameters a where
 -- >>> type SampleId = Integer
 -- >>> instance HasCountParam (APIRequest SampleApi [SampleId])
 -- >>> instance HasMaxIdParam (APIRequest SampleApi [SampleId])
--- >>> let sampleApiRequest :: APIRequest SampleApi [SampleId]; sampleApiRequest = APIRequestGet "https://api.twitter.com/sample/api.json" def
+-- >>> let sampleApiRequest :: APIRequest SampleApi [SampleId]; sampleApiRequest = APIRequest "GET" "https://api.twitter.com/sample/api.json" def
 
 -- | API request. You should use specific builder functions instead of building this directly.
 --
@@ -54,7 +55,7 @@ class Parameters a where
 -- instance 'HasCountParam' ('APIRequest' 'SampleApi' ['SampleId'])
 -- instance 'HasMaxIdParam' ('APIRequest' 'SampleApi' ['SampleId'])
 -- 'sampleApiRequest' :: 'APIRequest' 'SampleApi' ['SampleId']
--- 'sampleApiRequest' = 'APIRequestGet' \"https:\/\/api.twitter.com\/sample\/api.json\" 'def'
+-- 'sampleApiRequest' = 'APIRequest' \"GET\" \"https:\/\/api.twitter.com\/sample\/api.json\" 'def'
 -- @
 --
 -- We can obtain request params from @'APIRequest' SampleApi [SampleId]@ :
@@ -70,28 +71,32 @@ class Parameters a where
 -- [("max_id",PVInteger {unPVInteger = 1234567890})]
 #endif
 data APIRequest apiName responseType
-    = APIRequestGet
-      { _url :: String
+    = APIRequest
+      { _method :: HT.Method
+      , _url :: String
       , _params :: APIQuery
       }
-    | APIRequestPost
-      { _url :: String
+    | APIRequestMultipart
+      { _method :: HT.Method
+      , _url :: String
       , _params :: APIQuery
+      , _part :: [Part]
       }
-    | APIRequestPostMultipart
-      { _url :: String
+    | APIRequestJSON
+      { _method :: HT.Method
+      , _url :: String
       , _params :: APIQuery
-      , _part :: [Part]
+      , _body :: Value
       }
 instance Parameters (APIRequest apiName responseType) where
-    params f (APIRequestGet u pa) = APIRequestGet u <$> f pa
-    params f (APIRequestPost u pa) = APIRequestPost u <$> f pa
-    params f (APIRequestPostMultipart u pa prt) =
-        (\p -> APIRequestPostMultipart u p prt) <$> f pa
+    params f (APIRequest m u pa) = APIRequest m u <$> f pa
+    params f (APIRequestMultipart m u pa prt) =
+        (\p -> APIRequestMultipart m u p prt) <$> f pa
+    params f (APIRequestJSON m u pa body) = (\p -> APIRequestJSON m u p body) <$> f pa
 instance Show (APIRequest apiName responseType) where
-    show (APIRequestGet u p) = "APIRequestGet " ++ show u ++ " " ++ show (makeSimpleQuery p)
-    show (APIRequestPost u p) = "APIRequestPost " ++ show u ++ " " ++ show (makeSimpleQuery p)
-    show (APIRequestPostMultipart u p _) = "APIRequestPostMultipart " ++ show u ++ " " ++ show (makeSimpleQuery p)
+    show (APIRequest m u p) = "APIRequest " ++ show m ++ " " ++ show u ++ " " ++ show (makeSimpleQuery p)
+    show (APIRequestMultipart m u p _) = "APIRequestMultipart " ++ show m ++ " " ++ show u ++ " " ++ show (makeSimpleQuery p)
+    show (APIRequestJSON m u p _) = "APIRequestJSON " ++ show m ++ " " ++ show u ++ " " ++ show (makeSimpleQuery p)
 
 type APIQuery = [APIQueryItem]
 type APIQueryItem = (ByteString, PV)