packages feed

twitter-conduit 0.0.3 → 0.0.4

raw patch · 13 files changed

+369/−45 lines, 13 filesdep +conduit-extradep +hspecdep −attoparsec-conduitdep −failuredep −lifted-basedep ~aesondep ~authenticate-oauthdep ~base

Dependencies added: conduit-extra, hspec

Dependencies removed: attoparsec-conduit, failure, lifted-base

Dependency ranges changed: aeson, authenticate-oauth, base, bytestring, conduit, data-default, http-client, http-conduit, lens, monad-control, resourcet, shakespeare, text, transformers, twitter-types

Files

.travis.yml view
@@ -1,30 +1,60 @@ language: haskell  env:-  - GHCVER=7.4.2-  - GHCVER=7.6.3-  - GHCVER=7.8.2-  - GHCVER=head+  global:+    # OAUTH_CONSUMER_KEY+    - secure: "U3hh6wJf87tdZmwLtPyMQ0ci39ouKvTm/JCi0CCz2jaPvWZR+4Tt7aYV5WYqzjSmgfBOqKpXTpwFBcvvWRty8rI1b8OtrlljC1zUcgf/hsz3hfPtv+GKW/ldYnqg7znyeAdxWEF1a4JszKgOJaGMdX7zSpFewgwEq7T4jAlebLA="+    # OAUTH_CONSUMER_SECRET+    - secure: "I4BGd16zNQE3WjnwgdT7OM5sIIMtT9DMFPNdnWJPcgYndDovnFAUDoTomaGo0Wue4h64vGWl26f2Nm04i2upJXxkzFFtU5Az6cwUjzkOve1yqrkkyPFTXC8MLQYX3Zz8scQ8h1IJCn0Luu5HsHsool6IFZpiUovLZbDXmY44yH4="+    # OAUTH_ACCESS_TOKEN+    - secure: "dW2pYRplxJ7HmJEo3lMgLlzfdOylBvWiV4PJt1j4GMDPJBOu3RM0h3zNkkxDoS9D0wWRkBEH0iN2Bh08v2z7sJtF3f/kgLvPlOy5mNSYcozwMdHJRlJEcXaGULHbZ4p79lVIOdTAhY2WU2QdP7PEv0BiqqVcysnfK0TGkTa+KEc="+    # OAUTH_ACCESS_SECRET+    - secure: "I5hzi7sONDn8KJAhmkroHsGNJ2zUxYq2iGamTV9lgMUDH0bwpMx+guzfZr+fGesdlUphM0t+ZCh9YH8BoVJsjZ/db9u/lotg78DKp1QwhrWnISqWj6TIfXrSLPkBwY+xFtxl6Ihsjyl+ileiK5sb0C9mC+zXidgBqEM73miAokY="+  matrix:+    - GHCVER=7.4.2+    - GHCVER=7.6.3+    - GHCVER=7.8.2 USE_COVERALLS=1 CABAL_FLAGS="-frun-integrated-test"+    - GHCVER=head  matrix:   allow_failures:     - env: GHCVER=head  before_install:-  - travis_retry sudo add-apt-repository -y ppa:hvr/ghc-  - travis_retry sudo apt-get update-  - travis_retry sudo apt-get install cabal-install-1.18 ghc-$GHCVER-  - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.18/bin:$PATH+  - |+    if [ $GHCVER = `ghc --numeric-version` ]; then+      echo "use system ghc: `which ghc` `ghc --numeric-version`"+    else+      travis_retry sudo add-apt-repository -y ppa:hvr/ghc+      travis_retry sudo apt-get update+      travis_retry sudo apt-get install  -y --force-yes cabal-install-1.18 ghc-$GHCVER+      export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.18/bin:$PATH+      echo "use ppa:hvr/ghc: `which ghc` `ghc --numeric-version`"+    fi  install:   - export PATH=$HOME/.cabal/bin:$PATH   - which cabal-  - cabal update+  - travis_retry cabal update   - cabal install happy --constraint="transformers < 0.4"   - cabal install --only-dependencies --enable-tests+  - "[ -n \"$USE_COVERALLS\" ] && travis_retry cabal install hpc-coveralls || true"   - ghc-pkg list  script:-  - cabal configure --enable-tests+  - |+    if [ -n "$USE_COVERALLS" ]; then+      cabal configure --enable-tests --enable-library-coverage $CABAL_FLAGS+    else+      cabal configure --enable-tests $CABAL_FLAGS+    fi   - cabal build-  - cabal test --show-details=always+  - |+    if [ -n "$USE_COVERALLS" ]; then+      run-cabal-test --show-details=always+    else+      cabal test --show-details=always+    fi++after_script:+  - "[ -n \"$USE_COVERALLS\" ] && hpc-coveralls spec_main || true"
Web/Twitter/Conduit/Api.hs view
@@ -47,6 +47,7 @@        , FriendsList        , friendsList        -- , followersList+       -- , friendshipsLookup         -- * Users        -- , accountSettings@@ -72,7 +73,11 @@        -- , usersContributors        -- , accuntRemoveProfileBanner        -- , accuntUpdateProfileBanner-       -- , accuntProfileBanner+       -- , usersProfileBanner+       -- , mutesUsersCreate+       -- , mutesUsersDestroy+       -- , mutesUsersIds+       -- , mutesUsersList         -- * Suggested Users        -- , usersSuggestionsSlug@@ -87,16 +92,39 @@        , favoritesCreate         -- * Lists+       -- , listsList        -- , listsStatuses+       -- , listsMembersDestroy        -- , listsMemberships        -- , listsSubscribers+       -- , listsSubscribersCreate        -- , listsSubscribersShow+       -- , listsSubscribersDestroy+       -- , listsSubscribersCreateAll        -- , listsMembersShow        , ListsMembers        , listsMembers-       -- , lists+       -- , listsMembersCreate+       -- , listsDestroy+       -- , listsUpdate+       -- , listsCreate        -- , listsShow        -- , listsSubscriptions+       -- , listsMembersDestroyAll+       -- , listsOwnerships++       -- * Saved Searches+       -- savedSearchesList+       -- savedSearchesShowId+       -- savedSearchesCreate+       -- savedSearchesDestroyId++       -- * Places & Geo+       -- geoIdPlaceId+       -- geoReverseGeocode+       -- geoSearch+       -- geoSimilarPlaces+       -- geoPlace        ) where  import Web.Twitter.Types
Web/Twitter/Conduit/Base.hs view
@@ -3,12 +3,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-}-#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE ConstraintKinds #-}-#else-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-#endif  module Web.Twitter.Conduit.Base        ( api@@ -47,19 +42,15 @@ 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 import Control.Monad.Logger import Control.Lens import Unsafe.Coerce -#if __GLASGOW_HASKELL__ >= 704-type TwitterBaseM m = ( C.MonadResource m+type TwitterBaseM m = ( MonadResource m                       , MonadLogger m                       )-#else-class (C.MonadResource m, MonadLogger m) => TwitterBaseM m-instance (C.MonadResource m, MonadLoger m) => TwitterBaseM m-#endif  makeRequest :: MonadIO m             => HT.Method -- ^ HTTP request method (GET or POST)@@ -191,7 +182,7 @@         CL.sourceList $ contents res         loop $ nextCursor res -sinkJSON :: ( C.MonadThrow m+sinkJSON :: ( MonadThrow m             , MonadLogger m             ) => C.Consumer ByteString m Value sinkJSON = do@@ -200,13 +191,13 @@     return js  sinkFromJSON :: ( FromJSON a-                , C.MonadThrow m+                , MonadThrow m                 , MonadLogger m                 ) => C.Consumer ByteString m a sinkFromJSON = do     v <- sinkJSON     case fromJSON v of-        Error err -> lift $ C.monadThrow $ TwitterError err+        Error err -> lift $ monadThrow $ TwitterError err         Success r -> return r  showBS :: Show a => a -> ByteString
Web/Twitter/Conduit/Cursor.hs view
@@ -53,7 +53,7 @@     { previousCursor :: Integer     , nextCursor :: Integer     , contents :: [wrapped]-    }+    } deriving Show  instance (FromJSON wrapped, CursorKey c) =>          FromJSON (WithCursor c wrapped) where
Web/Twitter/Conduit/Monad.hs view
@@ -101,7 +101,7 @@ getManager :: Monad m => TW m Manager getManager = asks twManager -signOAuthTW :: MonadUnsafeIO m+signOAuthTW :: MonadIO m             => Request             -> TW m Request signOAuthTW req = do
sample/oauth_callback.hs view
@@ -9,7 +9,7 @@  import Web.Scotty import qualified Network.HTTP.Types as HT-import Web.Twitter.Conduit hiding (text)+import Web.Twitter.Conduit hiding (text, lookup) import Web.Authenticate.OAuth (OAuth(..), Credential(..)) import qualified Web.Authenticate.OAuth as OA import qualified Network.HTTP.Conduit as HTTP
sample/oauth_pin.hs view
@@ -8,7 +8,7 @@  module Main where -import Web.Twitter.Conduit+import Web.Twitter.Conduit hiding (lookup) import Web.Authenticate.OAuth as OA import Network.HTTP.Conduit import qualified Data.Conduit as C
+ tests/ApiSpec.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}++module ApiSpec where++import Data.Conduit+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 qualified Web.Twitter.Conduit.Parameters as Param+import Web.Twitter.Types.Lens+import Control.Lens+import TestUtils++import Test.Hspec++import System.IO.Unsafe++self :: User+self = unsafePerformIO . run . call $ accountVerifyCredentials++spec :: Spec+spec = do+    unit+#ifdef RUN_INTEGRATED_TEST+    integrated+#endif++unit :: Spec+unit = return ()++integrated :: Spec+integrated = do+    describe "friendsIds" $ do+        it "returns a cursored collection of users IDs" $ do+            res <- run . call $ friendsIds (Param.ScreenNameParam "thimura")+            length (contents res) `shouldSatisfy` (> 0)++        it "iterate with sourceWithCursor" $ do+            friends <- run $ do+                let src = sourceWithCursor $ friendsIds (Param.ScreenNameParam "thimura")+                src $$ CL.consume+            length friends `shouldSatisfy` (>= 0)++    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)++        it "should raise error when specified list does not exists" $ do+            let action = run . call $ listsMembers (Param.ListNameParam "thimura/haskell_ne")+            action `shouldThrow` anyException++        it "iterate with sourceWithCursor" $ do+            members <- run $ do+                let src = sourceWithCursor $ listsMembers (Param.ListNameParam "thimura/haskell")+                src $$ CL.consume+            members ^.. traversed . userScreenName `shouldContain` ["Hackage"]
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}
+ tests/StatusSpec.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}++module StatusSpec where++import Data.Conduit+import qualified Data.Conduit.List as CL+import Web.Twitter.Conduit (call, accountVerifyCredentials, sourceWithMaxId)+import Web.Twitter.Conduit.Status as Status+import qualified Web.Twitter.Conduit.Parameters as Param+import Web.Twitter.Types.Lens+import Control.Lens+import TestUtils++import Test.Hspec++import System.IO.Unsafe++self :: User+self = unsafePerformIO . run . call $ accountVerifyCredentials++spec :: Spec+spec = do+    unit+#ifdef RUN_INTEGRATED_TEST+    integrated+#endif++unit :: Spec+unit = return ()++integrated :: Spec+integrated = do+    describe "mentionsTimeline" $ do+        it "returns the 20 most resent mentions for user" $ do+            res <- run $ call mentionsTimeline+            length res `shouldSatisfy` (> 0)+            let mentionsScreenName = res ^.. traversed . statusEntities . _Just . enUserMentions . traversed . entityBody . userEntityUserScreenName+            mentionsScreenName `shouldSatisfy` allOf folded (== (self ^. userScreenName))+            length mentionsScreenName `shouldSatisfy` (== length res)++    describe "userTimeline" $ do+        it "returns the 20 most recent tweets posted by the user indicated by ScreenNameParam" $ do+            res <- run . call $ userTimeline (Param.ScreenNameParam "thimura")+            length res `shouldSatisfy` (== 20)+            res `shouldSatisfy` (allOf folded (^. statusUser . userScreenName . to (== "thimura")))+        it "returns the recent tweets which include RTs when specified include_rts option" $ do+            res <- run . call+                   $ userTimeline (Param.ScreenNameParam "thimura")+                   & Param.count ?~ 100 & Param.includeRts ?~ True+            res `shouldSatisfy` (anyOf (folded . statusRetweet . _Just . statusUser . userScreenName) (/= "thimura"))+        it "iterate with sourceWithMaxId" $ do+            tl <- run $ do+                let src = sourceWithMaxId $ userTimeline (Param.ScreenNameParam "thimura") & Param.count ?~ 200+                src $$ CL.isolate 600 =$ CL.consume+            length tl `shouldSatisfy` (== 600)++            let ids = tl ^.. traversed . statusId+            zip ids (tail ids) `shouldSatisfy` all (\(a, b) -> a > b)++    describe "homeTimeline" $ do+        it "returns the most recent tweets in home timeline" $ do+            res <- run $ call homeTimeline+            length res `shouldSatisfy` (> 0)++    describe "retweetsOfMe" $ do+        let response = unsafePerformIO . run . call $ retweetsOfMe+        it "returns the most recent tweets authored by the authenticating user" $ do+             let screenNames = response ^.. traversed . statusUser . userScreenName+             screenNames `shouldSatisfy` allOf folded (== (self ^. userScreenName))+             length screenNames `shouldSatisfy` (== length response)+        it "returns the most recent tweets that have been retweeted by other" $ do+            response `shouldSatisfy` allOf (traversed . statusRetweetCount . _Just) (> 0)++    describe "showId" $ do+        it "works for the known tweets" $ do+            res <- run . call $ showId 477833886768959488+            res ^. statusId `shouldBe` 477833886768959488+            res ^. statusText `shouldBe` "真紅かわいいはアレセイア"+            res ^. statusCreatedAt `shouldBe` "Sat Jun 14 15:24:10 +0000 2014"+            res ^. statusUser . userScreenName `shouldBe` "thimura"++    describe "update & destroyId" $ do+        it "posts new tweet and destroy it" $ do+            res1 <- run . call $ update "おまえの明日が、今日よりもずっと、楽しい事で溢れているようにと、祈っているよ"+            res1 ^. statusUser . userScreenName `shouldBe` self ^. userScreenName++            res2 <- run . call $ destroyId (res1 ^. statusId)+            res2 ^. statusId `shouldBe` res1 ^. statusId++    describe "lookup" $ do+        it "works for the known tweets" $ do+            res <- run . call $ Status.lookup [438691466345340928, 477757405942411265]+            length res `shouldSatisfy` (== 2)+            (res !! 0) ^. statusId `shouldBe` 438691466345340928+            (res !! 1) ^. statusId `shouldBe` 477757405942411265
+ tests/TestUtils.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}++module TestUtils (runTwitterFromEnv, run) where++import Web.Twitter.Conduit++import Web.Authenticate.OAuth as OA+import qualified Network.URI as URI+import Network.HTTP.Conduit+import qualified Data.Map as M+import qualified Data.ByteString.Char8 as S8+import qualified Data.CaseInsensitive as CI+import Control.Applicative+import Control.Monad.IO.Class+import Control.Monad.Base+import Control.Monad.Trans.Resource+import System.Environment+import Control.Monad.Logger+import Control.Lens++getOAuthTokens :: IO (OAuth, Credential)+getOAuthTokens = do+    consumerKey <- getEnv' "OAUTH_CONSUMER_KEY"+    consumerSecret <- getEnv' "OAUTH_CONSUMER_SECRET"+    accessToken <- getEnv' "OAUTH_ACCESS_TOKEN"+    accessSecret <- getEnv' "OAUTH_ACCESS_SECRET"+    let oauth = twitterOAuth+            { oauthConsumerKey = consumerKey+            , oauthConsumerSecret = consumerSecret+            }+        cred = Credential+            [ ("oauth_token", accessToken)+            , ("oauth_token_secret", accessSecret)+            ]+    return (oauth, cred)+  where+    getEnv' = (S8.pack <$>) . getEnv++getProxyEnv :: IO (Maybe Proxy)+getProxyEnv = do+    env <- M.fromList . over (mapped . _1) CI.mk <$> getEnvironment+    let u = M.lookup "https_proxy" env <|>+            M.lookup "http_proxy" env <|>+            M.lookup "proxy" env >>= URI.parseURI >>= URI.uriAuthority+    return $ Proxy <$> (S8.pack . URI.uriRegName <$> u) <*> (parsePort . URI.uriPort <$> u)+  where+    parsePort :: String -> Int+    parsePort []       = 8080+    parsePort (':':xs) = read xs+    parsePort xs       = error $ "port number parse failed " ++ xs++runTwitterFromEnv :: (MonadIO m, MonadBaseControl IO m) => TW (ResourceT m) a -> m a+runTwitterFromEnv task = do+    pr <- liftBase getProxyEnv+    (oa, cred) <- liftBase getOAuthTokens+    let env = (setCredential oa cred def) { twProxy = pr }+    runTW env task++#ifdef USE_DEBUG_OUTPUT+run :: (MonadIO m, MonadBaseControl IO m) => TW (ResourceT (LoggingT m)) a -> m a+run = runStderrLoggingT . runTwitterFromEnv+#else+run :: (MonadIO m, MonadBaseControl IO m) => TW (ResourceT (NoLoggingT m)) a -> m a+run = runNoLoggingT . runTwitterFromEnv+#endif
+ tests/spec_main.hs view
@@ -0,0 +1,4 @@+import Spec+import Test.Hspec++main = hspec spec
twitter-conduit.cabal view
@@ -1,5 +1,5 @@ name:              twitter-conduit-version:           0.0.3+version:           0.0.4 license:           BSD3 license-file:      LICENSE author:            HATTORI Hiroki, Hideyuki Tanaka, Takahiro HIMURA@@ -35,29 +35,33 @@   description: build samples   default: False +flag use-debug-output+  description: use debug output when running testsuites+  default: False++flag run-integrated-test+  description: use debug output when running testsuites+  default: False+ library   ghc-options: -Wall    build-depends:-      base >= 4 && < 5+      base >= 4.5 && < 5     , transformers >= 0.2.2-    , transformers-base     , template-haskell-    , lifted-base >= 0.1-    , monad-control >= 0.3     , lens >= 4.0     , authenticate-oauth >= 1.3-    , resourcet >= 0.4.3 && < 0.5-    , conduit >= 1.0 && < 1.1-    , failure >= 0.2+    , resourcet >= 1.0+    , conduit >= 1.1+    , conduit-extra >= 1.1     , monad-logger     , shakespeare >= 2.0     , http-types-    , http-conduit >= 2.0 && < 2.1+    , http-conduit >= 2.0 && < 2.2     , http-client >= 0.3     , aeson >= 0.7     , attoparsec >= 0.10-    , attoparsec-conduit >= 1.0     , data-default >= 0.3     , bytestring >= 0.9     , text >= 0.11@@ -101,6 +105,49 @@     , directory     , doctest +test-suite spec_main+  type: exitcode-stdio-1.0+  main-is: spec_main.hs+  hs-source-dirs: tests, .+  if flag(use-debug-output)+    CPP-Options: -DUSE_DEBUG_OUTPUT++  if flag(run-integrated-test)+    CPP-Options: -DRUN_INTEGRATED_TEST++  build-depends:+      base >= 4.5 && < 5+    , template-haskell+    , transformers-base+    , transformers+    , monad-control+    , lens+    , bytestring+    , time+    , text+    , aeson+    , attoparsec >= 0.10+    , shakespeare+    , data-default+    , resourcet+    , conduit+    , conduit-extra >= 1.1+    , http-types+    , http-conduit+    , http-client+    , monad-logger+    , authenticate-oauth+    , case-insensitive+    , network+    , containers+    , hspec+    , twitter-types+  other-modules:+    Spec+    ApiSpec+    StatusSpec+    TestUtils+ executable simple   main-is: simple.hs   hs-source-dirs: sample/@@ -109,7 +156,7 @@     buildable: False   else     build-depends:-        base >= 4.0 && < 5+        base >= 4.5 && < 5       , transformers-base       , transformers       , monad-control@@ -132,7 +179,7 @@     buildable: False   else     build-depends:-        base >= 4.0 && < 5+        base >= 4.5 && < 5       , containers       , transformers-base       , transformers@@ -162,7 +209,7 @@     buildable: False   else     build-depends:-        base >= 4.0 && < 5+        base >= 4.5 && < 5       , containers       , transformers-base       , transformers@@ -185,7 +232,7 @@     buildable: False   else     build-depends:-        base >= 4.0 && < 5+        base >= 4.5 && < 5       , containers       , transformers-base       , transformers