twitter-conduit 0.0.4 → 0.0.5
raw patch · 19 files changed
+390/−120 lines, 19 filesdep ~conduit-extra
Dependency ranges changed: conduit-extra
Files
- .travis.yml +1/−1
- Web/Twitter/Conduit.hs +11/−0
- Web/Twitter/Conduit/Api.hs +36/−1
- Web/Twitter/Conduit/Base.hs +66/−20
- Web/Twitter/Conduit/Cursor.hs +0/−64
- Web/Twitter/Conduit/Error.hs +0/−15
- Web/Twitter/Conduit/Parameters.hs +2/−0
- Web/Twitter/Conduit/Parameters/Internal.hs +31/−0
- Web/Twitter/Conduit/Parameters/TH.hs +9/−5
- Web/Twitter/Conduit/Status.hs +2/−4
- Web/Twitter/Conduit/Stream.hs +3/−2
- Web/Twitter/Conduit/Types.hs +150/−0
- Web/Twitter/Conduit/Types/Lens.hs +32/−0
- Web/Twitter/Conduit/Types/TH.hs +9/−0
- sample/oauth_pin.hs +2/−1
- sample/postWithMultipleMedia.hs +27/−0
- sample/simple.hs +1/−1
- tests/ApiSpec.hs +3/−3
- twitter-conduit.cabal +5/−3
.travis.yml view
@@ -57,4 +57,4 @@ fi after_script:- - "[ -n \"$USE_COVERALLS\" ] && hpc-coveralls spec_main || true"+ - "[ -n \"$USE_COVERALLS\" ] && hpc-coveralls --exclude-dir=tests spec_main || true"
Web/Twitter/Conduit.hs view
@@ -25,8 +25,19 @@ , module Web.Twitter.Conduit.Request , module Web.Twitter.Conduit.Parameters , module Web.Twitter.Types.Lens++ , MediaData (..)+ , UploadedMedia+ , mediaId+ , mediaSize+ , mediaImage+ , ImageSizeType+ , imageWidth+ , imageHeight+ , imageType ) where +import Web.Twitter.Conduit.Types import Web.Twitter.Conduit.Base import Web.Twitter.Conduit.Api import Web.Twitter.Conduit.Status
Web/Twitter/Conduit/Api.hs view
@@ -125,15 +125,20 @@ -- geoSearch -- geoSimilarPlaces -- geoPlace++ -- * media+ , MediaUpload+ , mediaUpload ) where import Web.Twitter.Types+import Web.Twitter.Conduit.Types import Web.Twitter.Conduit.Parameters import Web.Twitter.Conduit.Parameters.TH import Web.Twitter.Conduit.Base import Web.Twitter.Conduit.Request-import Web.Twitter.Conduit.Cursor +import Network.HTTP.Client.MultipartFormData import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Default@@ -555,3 +560,33 @@ , "skip_status" ] +data MediaUpload+-- | Upload media and returns the media data.+--+-- You can update your status with multiple media by calling 'mediaUpload' and 'update' successively.+--+-- First, you should upload media with 'mediaUpload':+--+-- @+-- res1 <- 'call' '$' 'mediaUpload' ('MediaFromFile' \"\/path\/to\/upload\/file1.png\")+-- res2 <- 'call' '$' 'mediaUpload' ('MediaRequestBody' \"file2.png\" \"[.. file body ..]\")+-- @+--+-- and then collect the resulting media IDs and update your status by calling 'update':+--+-- @+-- 'call' '$' 'update' \"Hello World\" '&' 'mediaIds' '?~' ['mediaId' res1, 'mediaId' res2]+-- @+--+-- See: <https://dev.twitter.com/docs/api/multiple-media-extended-entities>+--+-- >>> mediaUpload (MediaFromFile "/home/test/test.png")+-- APIRequestPostMultipart "https://upload.twitter.com/1.1/media/upload.json" []+mediaUpload :: MediaData+ -> APIRequest MediaUpload UploadedMedia+mediaUpload mediaData =+ APIRequestPostMultipart uri [] [mediaBody mediaData]+ where+ uri = "https://upload.twitter.com/1.1/media/upload.json"+ mediaBody (MediaFromFile fp) = partFileSource "media" fp+ mediaBody (MediaRequestBody filename filebody) = partFileRequestBody "media" filename filebody
Web/Twitter/Conduit/Base.hs view
@@ -4,12 +4,14 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE RecordWildCards #-} module Web.Twitter.Conduit.Base ( api , apiRequest , call , call'+ , checkResponse , sourceWithMaxId , sourceWithCursor , TwitterBaseM@@ -22,13 +24,12 @@ import Prelude as P import Web.Twitter.Conduit.Monad-import Web.Twitter.Conduit.Error+import Web.Twitter.Conduit.Types import Web.Twitter.Conduit.Parameters import Web.Twitter.Conduit.Request-import Web.Twitter.Conduit.Cursor import Web.Twitter.Types.Lens -import Network.HTTP.Conduit+import qualified Network.HTTP.Conduit as HTTP import Network.HTTP.Client.MultipartFormData import qualified Network.HTTP.Types as HT import qualified Data.Conduit as C@@ -40,7 +41,6 @@ import qualified Data.Text.Encoding as T import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8-import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Resource (MonadResource, MonadThrow, monadThrow) import Text.Shakespeare.Text@@ -52,41 +52,87 @@ , MonadLogger m ) -makeRequest :: MonadIO m+makeRequest :: MonadThrow m => HT.Method -- ^ HTTP request method (GET or POST) -> String -- ^ API Resource URL -> HT.SimpleQuery -- ^ Query- -> TW m Request+ -> TW m HTTP.Request makeRequest m url query = do p <- getProxy- req <- liftIO $ parseUrl url- return $ req { method = m- , queryString = HT.renderSimpleQuery False query- , proxy = p }+ req <- HTTP.parseUrl url+ return $ req { HTTP.method = m+ , HTTP.queryString = HT.renderSimpleQuery False query+ , HTTP.proxy = p+ , HTTP.checkStatus = \_ _ _ -> Nothing+ } api :: TwitterBaseM m => HT.Method -- ^ HTTP request method (GET or POST) -> String -- ^ API Resource URL -> HT.SimpleQuery -- ^ Query- -> TW m (C.ResumableSource (TW m) ByteString)+ -> TW m (Response (C.ResumableSource (TW m) ByteString)) api m url query = apiRequest =<< makeRequest m url query apiRequest :: TwitterBaseM m- => Request- -> TW m (C.ResumableSource (TW m) ByteString)+ => HTTP.Request+ -> TW m (Response (C.ResumableSource (TW m) ByteString)) apiRequest req = do signedReq <- signOAuthTW req $(logDebug) [st|Signed Request: #{show signedReq}|] mgr <- getManager- res <- http signedReq mgr- $(logDebug) [st|Response Status: #{show $ responseStatus res}|]- $(logDebug) [st|Response Header: #{show $ responseHeaders res}|]- return $ responseBody res+ res <- HTTP.http signedReq mgr+ $(logDebug) [st|Response Status: #{show $ HTTP.responseStatus res}|]+ $(logDebug) [st|Response Header: #{show $ HTTP.responseHeaders res}|]+ return+ Response { responseStatus = HTTP.responseStatus res+ , responseHeaders = HTTP.responseHeaders res+ , responseBody = HTTP.responseBody res+ } endpoint :: String endpoint = "https://api.twitter.com/1.1/" +getValue :: (MonadLogger m, MonadThrow m)+ => Response (C.ResumableSource (TW m) ByteString)+ -> TW m (Response Value)+getValue res = do+ value <- responseBody res C.$$+- sinkJSON+ return $ res { responseBody = value }++checkResponse :: Response Value+ -> Either TwitterError Value+checkResponse Response{..} =+ case responseBody ^? key "errors" of+ Just errs ->+ case fromJSON errs of+ Success errList -> Left $ TwitterErrorResponse responseStatus responseHeaders errList+ Error msg -> Left $ FromJSONError msg+ Nothing ->+ if sci < 200 || sci > 400+ then Left $ TwitterStatusError responseStatus responseHeaders responseBody+ else Right responseBody+ where+ sci = HT.statusCode responseStatus++getValueOrThrow :: (MonadThrow m, MonadLogger m, FromJSON a)+ => Response (C.ResumableSource (TW m) ByteString)+ -> TW m a+getValueOrThrow res = do+ val <- getValueOrThrow' res+ case fromJSON val of+ Success r -> return r+ Error err -> monadThrow $ FromJSONError err++getValueOrThrow' :: (MonadLogger m, MonadThrow m)+ => Response (C.ResumableSource (TW m) ByteString)+ -> TW m Value+getValueOrThrow' res = do+ res' <- getValue res+ case checkResponse res' of+ Left err -> monadThrow err+ Right v -> return v+ apiValue :: (TwitterBaseM m, FromJSON a) => HT.Method -- ^ HTTP request method (GET or POST) -> String -- ^ API Resource URL@@ -94,7 +140,7 @@ -> TW m a apiValue m url query = do src <- api m url query- src C.$$+- sinkFromJSON+ getValueOrThrow src call :: (TwitterBaseM m, FromJSON responseType) => APIRequest apiName responseType@@ -109,7 +155,7 @@ call' (APIRequestPostMultipart u param prt) = do req <- formDataBody body =<< makeRequest "POST" u [] src <- apiRequest req- src C.$$+- sinkFromJSON+ getValueOrThrow src where body = prt ++ partParam partParam = P.map (uncurry partBS . over _1 T.decodeUtf8) param@@ -197,7 +243,7 @@ sinkFromJSON = do v <- sinkJSON case fromJSON v of- Error err -> lift $ monadThrow $ TwitterError err+ Error err -> monadThrow $ FromJSONError err Success r -> return r showBS :: Show a => a -> ByteString
− Web/Twitter/Conduit/Cursor.hs
@@ -1,64 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE CPP #-}--module Web.Twitter.Conduit.Cursor- ( CursorKey (..)- , IdsCursorKey- , UsersCursorKey- , WithCursor (..)- ) where--import Web.Twitter.Types (checkError)-import qualified Data.Text as T-import Data.Aeson-import Data.Monoid-import Control.Applicative---- $setup--- >>> type UserId = Integer--class CursorKey a where- cursorKey :: a -> T.Text---- | 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"--#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)--- >>> nextCursor res--- 1234567890--- >>> contents res--- [1111111111]------ >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 0, \"users\": [1000]}" :: Maybe (WithCursor UsersCursorKey UserId)--- >>> nextCursor res--- 0--- >>> contents res--- [1000]-#endif-data WithCursor cursorKey wrapped = WithCursor- { previousCursor :: Integer- , nextCursor :: Integer- , contents :: [wrapped]- } deriving Show--instance (FromJSON wrapped, CursorKey c) =>- FromJSON (WithCursor c wrapped) where- parseJSON (Object o) = checkError o >>- WithCursor <$> o .: "previous_cursor"- <*> o .: "next_cursor"- <*> o .: cursorKey (undefined :: c)- parseJSON _ = mempty
− Web/Twitter/Conduit/Error.hs
@@ -1,15 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Web.Twitter.Conduit.Error- ( TwitterError (..)- ) where--import Control.Exception-import Data.Data--data TwitterError- = TwitterError String- deriving (Show, Data, Typeable)--instance Exception TwitterError-
Web/Twitter/Conduit/Parameters.hs view
@@ -24,6 +24,7 @@ , HasSkipStatusParam (..) , HasFollowParam (..) , HasMapParam (..)+ , HasMediaIdsParam (..) , UserParam(..) , UserListParam(..)@@ -73,6 +74,7 @@ defineHasParamClass "skip_status" ''Bool 'booleanQuery defineHasParamClass "follow" ''Bool 'booleanQuery defineHasParamClass "map" ''Bool 'booleanQuery+defineHasParamClass' "media_ids" [t|[Integer]|] 'integerArrayQuery -- | converts 'UserParam' to 'HT.SimpleQuery'. --
Web/Twitter/Conduit/Parameters/Internal.hs view
@@ -5,12 +5,14 @@ ( Parameters(..) , readShow , booleanQuery+ , integerArrayQuery , wrappedParam ) where import qualified Network.HTTP.Types as HT import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8+import Data.Maybe import Control.Lens class Parameters a where@@ -52,6 +54,35 @@ sb "1" = Just True sb "t" = Just True sb _ = Just False++-- | This 'Prism' convert from a 'ByteString' to the array of 'Integer' value.+--+-- This is not a valid Prism, for example:+--+-- @+-- "1, 2" ^? integerArrayQuery == Just [1,2]+-- integerArrayQuery # [1,2] != "1, 2"+-- @+--+-- >>> integerArrayQuery # [1]+-- "1"+-- >>> integerArrayQuery # [1,2234,3]+-- "1,2234,3"+-- >>> "1,2234,3" ^? integerArrayQuery+-- Just [1,2234,3]+-- >>> "" ^? integerArrayQuery+-- Just []+-- >>> "hoge,2" ^? integerArrayQuery+-- Nothing+integerArrayQuery :: Prism' S.ByteString [Integer]+integerArrayQuery = prism' bs_arr arr_bs+ where+ bs_arr xs = S8.intercalate "," $ xs ^.. traversed . re readShow+ arr_bs str = chkValid $ map (^? readShow) $ S8.split ',' str+ chkValid arr =+ if all isJust arr+ then Just (catMaybes arr)+ else Nothing wrappedParam :: Parameters p => S.ByteString -> Prism' S.ByteString a -> Lens' p (Maybe a) wrappedParam key aSBS = lens getter setter
Web/Twitter/Conduit/Parameters/TH.hs view
@@ -29,19 +29,23 @@ -> Name -- ^ parameter type -> Name -- ^ a Prism -> Q [Dec]-defineHasParamClass paramName typeN prismN =- defineHasParamClass' cNameS fNameS paramName typeN prismN+defineHasParamClass paramName typeN =+ defineHasParamClass' paramName (conT typeN)++defineHasParamClass' :: String -> TypeQ -> Name -> Q [Dec]+defineHasParamClass' paramName typeQ =+ defineHasParamClass'' cNameS fNameS paramName typeQ where cNameS = paramNameToClassName paramName fNameS = snakeToLowerCamel paramName -defineHasParamClass' :: String -> String -> String -> Name -> Name -> Q [Dec]-defineHasParamClass' cNameS fNameS paramName typeN prismN = do+defineHasParamClass'' :: String -> String -> String -> TypeQ -> Name -> Q [Dec]+defineHasParamClass'' cNameS fNameS paramName typeQ prismN = do a <- newName "a" cName <- newName cNameS fName <- newName fNameS let cCxt = cxt [classP ''Parameters [varT a]]- tySig = sigD fName (appT (appT (conT ''Lens') (varT a)) (appT (conT ''Maybe) (conT typeN)))+ tySig = sigD fName (appT (appT (conT ''Lens') (varT a)) (appT (conT ''Maybe) typeQ)) valDef = valD (varP fName) (normalB (appE (appE (varE 'wrappedParam) (litE (stringL paramName))) (varE prismN))) [] dec <- classD cCxt cName [PlainTV a] [] [tySig, valDef] return [dec]
Web/Twitter/Conduit/Status.hs view
@@ -43,6 +43,7 @@ import Prelude hiding ( lookup ) import Web.Twitter.Conduit.Base import Web.Twitter.Conduit.Request+import Web.Twitter.Conduit.Types import Web.Twitter.Conduit.Parameters import Web.Twitter.Conduit.Parameters.TH import Web.Twitter.Types@@ -51,7 +52,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import Network.HTTP.Client.MultipartFormData-import Network.HTTP.Conduit import Data.Default -- $setup@@ -242,6 +242,7 @@ -- , "place_id" , "display_coordinates" , "trim_user"+ , "media_ids" ] data StatusesRetweetId@@ -261,9 +262,6 @@ deriveHasParamInstances ''StatusesRetweetId [ "trim_user" ]--data MediaData = MediaFromFile FilePath- | MediaRequestBody FilePath RequestBody data StatusesUpdateWithMedia -- | Returns post data which updates the authenticating user's current status and attaches media for upload.
Web/Twitter/Conduit/Stream.hs view
@@ -20,6 +20,7 @@ , stream ) where +import Web.Twitter.Conduit.Types import Web.Twitter.Conduit.Base import Web.Twitter.Conduit.Monad import Web.Twitter.Types@@ -52,10 +53,10 @@ -> TW m (C.ResumableSource (TW m) value) stream' (APIRequestGet u pa) = do rsrc <- api "GET" u pa- rsrc $=+ CL.sequence sinkFromJSON+ responseBody rsrc $=+ CL.sequence sinkFromJSON stream' (APIRequestPost u pa) = do rsrc <- api "POST" u pa- rsrc $=+ CL.sequence sinkFromJSON+ responseBody rsrc $=+ CL.sequence sinkFromJSON stream' APIRequestPostMultipart {} = error "APIRequestPostMultipart is not supported by stream function."
+ Web/Twitter/Conduit/Types.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}++module Web.Twitter.Conduit.Types+ ( Response (..)+ , TwitterError (..)+ , TwitterErrorMessage (..)+ , CursorKey (..)+ , IdsCursorKey+ , UsersCursorKey+ , WithCursor (..)+ , MediaData (..)+ , UploadedMedia (..)+ , ImageSizeType (..)+ ) where+++import Control.Applicative+import Control.Exception+import Data.Aeson+import Data.Data+import Data.Foldable (Foldable)+import Data.Monoid+import qualified Data.Text as T+import Data.Traversable (Traversable)+import Network.HTTP.Client (RequestBody)+import Network.HTTP.Types (Status, ResponseHeaders)+import Web.Twitter.Types (checkError)++-- $setup+-- >>> type UserId = Integer+++class CursorKey a where+ cursorKey :: a -> T.Text++-- | 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"++#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)+-- >>> nextCursor res+-- 1234567890+-- >>> contents res+-- [1111111111]+--+-- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 0, \"users\": [1000]}" :: Maybe (WithCursor UsersCursorKey UserId)+-- >>> nextCursor res+-- 0+-- >>> contents res+-- [1000]+#endif+data WithCursor cursorKey wrapped = WithCursor+ { previousCursor :: Integer+ , nextCursor :: Integer+ , contents :: [wrapped]+ } deriving Show++instance (FromJSON wrapped, CursorKey c) =>+ FromJSON (WithCursor c wrapped) where+ parseJSON (Object o) = checkError o >>+ WithCursor <$> o .: "previous_cursor"+ <*> o .: "next_cursor"+ <*> o .: cursorKey (undefined :: c)+ parseJSON _ = mempty++data MediaData = MediaFromFile FilePath+ | MediaRequestBody FilePath RequestBody++data ImageSizeType = ImageSizeType+ { imageWidth :: Int+ , imageHeight :: Int+ , imageType :: T.Text+ } deriving Show+instance FromJSON ImageSizeType where+ parseJSON (Object o) =+ ImageSizeType <$> o .: "w"+ <*> o .: "h"+ <*> o .: "image_type"+ parseJSON v = fail $ "unknown value: " ++ show v++data UploadedMedia = UploadedMedia+ { mediaId :: Integer+ , mediaSize :: Integer+ , mediaImage :: ImageSizeType+ } deriving Show+instance FromJSON UploadedMedia where+ parseJSON (Object o) =+ UploadedMedia <$> o .: "media_id"+ <*> o .: "size"+ <*> o .: "image"+ parseJSON v = fail $ "unknown value: " ++ show v++data Response responseType = Response+ { responseStatus :: Status+ , responseHeaders :: ResponseHeaders+ , responseBody :: responseType+ } deriving (Show, Eq, Typeable, Functor, Foldable, Traversable)++data TwitterError+ = FromJSONError String+ | TwitterErrorResponse Status ResponseHeaders [TwitterErrorMessage]+ | TwitterStatusError Status ResponseHeaders Value+ deriving (Show, Typeable, Eq)++instance Exception TwitterError++-- | Twitter Error Messages+--+-- see detail: <https://dev.twitter.com/docs/error-codes-responses>+data TwitterErrorMessage = TwitterErrorMessage+ { twitterErrorCode :: Int+ , twitterErrorMessage :: T.Text+ } deriving (Show, Data, Typeable)++instance Eq TwitterErrorMessage where+ TwitterErrorMessage { twitterErrorCode = a } == TwitterErrorMessage { twitterErrorCode = b }+ = a == b++instance Ord TwitterErrorMessage where+ compare TwitterErrorMessage { twitterErrorCode = a } TwitterErrorMessage { twitterErrorCode = b }+ = a `compare` b++instance Enum TwitterErrorMessage where+ fromEnum = twitterErrorCode+ toEnum a = TwitterErrorMessage a T.empty++instance FromJSON TwitterErrorMessage where+ parseJSON (Object o) =+ TwitterErrorMessage+ <$> o .: "code"+ <*> o .: "message"+ parseJSON v = fail $ "unexpected: " ++ show v
+ Web/Twitter/Conduit/Types/Lens.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TemplateHaskell #-}++module Web.Twitter.Conduit.Types.Lens+ ( TT.Response+ , responseStatus+ , responseBody+ , responseHeaders+ , TT.WithCursor+ , previousCursor+ , nextCursor+ , contents+ , TT.ImageSizeType+ , imageWidth+ , imageHeight+ , imageType+ , TT.UploadedMedia+ , mediaId+ , mediaSize+ , mediaImage+ , TT.TwitterErrorMessage+ , twitterErrorMessage+ , twitterErrorCode+ ) where++import qualified Web.Twitter.Conduit.Types as TT+import Web.Twitter.Conduit.Types.TH++makeLenses ''TT.WithCursor+makeLenses ''TT.ImageSizeType+makeLenses ''TT.UploadedMedia+makeLenses ''TT.Response+makeLenses ''TT.TwitterErrorMessage
+ Web/Twitter/Conduit/Types/TH.hs view
@@ -0,0 +1,9 @@+module Web.Twitter.Conduit.Types.TH+ ( makeLenses+ ) where++import Control.Lens hiding (makeLenses)+import Language.Haskell.TH++makeLenses :: Name -> Q [Dec]+makeLenses = makeLensesWith (defaultRules & lensField .~ Just)
sample/oauth_pin.hs view
@@ -16,6 +16,7 @@ import Data.Maybe import Data.Monoid import Control.Monad.Trans.Control+import Control.Monad.Trans.Resource import Control.Monad.IO.Class import System.Environment import System.IO (hFlush, stdout)@@ -31,7 +32,7 @@ , oauthCallback = Just "oob" } -authorize :: (MonadBaseControl IO m, C.MonadResource m)+authorize :: (MonadBaseControl IO m, MonadResource m) => OAuth -- ^ OAuth Consumer key and secret -> Manager -> m Credential
+ sample/postWithMultipleMedia.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import qualified Data.Text as T+import Web.Twitter.Conduit+import System.Environment+import System.Exit (exitFailure)+import System.IO+import Control.Lens+import Control.Monad.IO.Class+import Control.Monad+import Common++main :: IO ()+main = runTwitterFromEnv' $ do+ (status:filepathList) <- liftIO getArgs+ when (length filepathList > 4) $ liftIO $ do+ hPutStrLn stderr $ "You can upload upto 4 images in a single tweet, but we got " ++ show (length filepathList) ++ " images. abort."+ exitFailure+ uploadedMediaList <- forM filepathList $ \filepath -> do+ liftIO $ putStrLn $ "Upload media: " ++ filepath+ ret <- call $ mediaUpload (MediaFromFile filepath)+ liftIO $ putStrLn $ "Upload completed: media_id: " ++ ret ^. mediaId . to show ++ ", filepath: " ++ filepath+ return ret+ liftIO $ putStrLn $ "Post message: " ++ status+ res <- call $ update (T.pack status) & mediaIds ?~ (uploadedMediaList ^.. traversed . mediaId)+ liftIO $ print res
sample/simple.hs view
@@ -26,7 +26,7 @@ , oauthConsumerSecret = error "You MUST specify oauthConsumerSecret parameter." } -authorize :: (MonadBaseControl IO m, C.MonadResource m)+authorize :: (MonadBaseControl IO m, MonadResource m) => OAuth -- ^ OAuth Consumer key and secret -> (String -> m String) -- ^ PIN prompt -> Manager
tests/ApiSpec.hs view
@@ -7,7 +7,7 @@ import qualified Data.Conduit.List as CL import Web.Twitter.Conduit (call, sourceWithCursor) import Web.Twitter.Conduit.Api-import Web.Twitter.Conduit.Cursor (contents)+import Web.Twitter.Conduit.Types.Lens import qualified Web.Twitter.Conduit.Parameters as Param import Web.Twitter.Types.Lens import Control.Lens@@ -35,7 +35,7 @@ describe "friendsIds" $ do it "returns a cursored collection of users IDs" $ do res <- run . call $ friendsIds (Param.ScreenNameParam "thimura")- length (contents res) `shouldSatisfy` (> 0)+ res ^. contents . to length `shouldSatisfy` (> 0) it "iterate with sourceWithCursor" $ do friends <- run $ do@@ -46,7 +46,7 @@ describe "listsMembers" $ do it "returns a cursored collection of the member of specified list" $ do res <- run . call $ listsMembers (Param.ListNameParam "thimura/haskell")- length (contents res) `shouldSatisfy` (>= 0)+ res ^. contents . to length `shouldSatisfy` (>= 0) it "should raise error when specified list does not exists" $ do let action = run . call $ listsMembers (Param.ListNameParam "thimura/haskell_ne")
twitter-conduit.cabal view
@@ -1,5 +1,5 @@ name: twitter-conduit-version: 0.0.4+version: 0.0.5 license: BSD3 license-file: LICENSE author: HATTORI Hiroki, Hideyuki Tanaka, Takahiro HIMURA@@ -71,10 +71,11 @@ exposed-modules: Web.Twitter.Conduit+ Web.Twitter.Conduit.Types+ Web.Twitter.Conduit.Types.Lens+ Web.Twitter.Conduit.Types.TH Web.Twitter.Conduit.Base- Web.Twitter.Conduit.Cursor Web.Twitter.Conduit.Api- Web.Twitter.Conduit.Error Web.Twitter.Conduit.Monad Web.Twitter.Conduit.Stream Web.Twitter.Conduit.Status@@ -196,6 +197,7 @@ , data-default , resourcet , conduit+ , conduit-extra , http-conduit , monad-logger , authenticate-oauth