twitter-conduit 0.1.0 → 0.1.1

raw patch · 12 files changed

+228/−50 lines, 12 filesdep ~bytestringdep ~lensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bytestring, lens

API changes (from Hackage documentation)

Files

• .gitignore +2/−0
• .travis.yml +36/−40
• ChangeLog.md +3/−0
• README.md +3/−1
• Web/Twitter/Conduit.hs +3/−1
• Web/Twitter/Conduit/Base.hs +55/−0
• Web/Twitter/Conduit/Request.hs +1/−1
• sample/searchSource.hs +27/−0
• sample/userstream.hs +2/−3
• tests/BaseSpec.hs +88/−0
• tests/StatusSpec.hs +2/−1
• twitter-conduit.cabal +6/−3

@@ -24,3 +24,5 @@ cabal-dev/ cabal.sandbox.config .cabal-sandbox+.stack-work/+stack.yaml

@@ -1,7 +1,18 @@-language: haskell+language: sh+sudo: required  env:+  matrix:+    - GHCVER=7.4.2+    - GHCVER=7.6.3+    - GHCVER=7.8.4+    - GHCVER=7.10.1 CABAL_FLAGS="-frun-integrated-test"   global:+    # HALCYON_AWS_ACCESS_KEY_ID+    - secure: "PTnc4TbawOwE6Z3v9QP5TRVYKg7FXU4PKgMqRPOy7HRwCriF+v4CxkyFgI2Ve614z85dF3kq9qZrhtyRuTSTL/SAu17Tz57+XhH0laGDF/7/h637ZRxy0+OBv/EDO0z6cJ1+8ndAl+5fbblQ8nmn5fgPrVCfbNIpujcjOSfs8+4="+    # HALCYON_AWS_SECRET_ACCESS_KEY+    - secure: "RCLM7gnzb0b4WgYeDQ+z1cn+IvsJMaqldLppJRM/b+oBeH5v+IZ0BL4hRk187iZsXJdMADC6MAeEchcV0rTseit/zKQAk6fx7360Sv+MdlzNbVHSiO7LpwbKTOvMfIQ5hB/S8oTuC1qmY18JhShO1lE6RpFsitwNdENRZv85fuQ="+     # OAUTH_CONSUMER_KEY     - secure: "U3hh6wJf87tdZmwLtPyMQ0ci39ouKvTm/JCi0CCz2jaPvWZR+4Tt7aYV5WYqzjSmgfBOqKpXTpwFBcvvWRty8rI1b8OtrlljC1zUcgf/hsz3hfPtv+GKW/ldYnqg7znyeAdxWEF1a4JszKgOJaGMdX7zSpFewgwEq7T4jAlebLA="     # OAUTH_CONSUMER_SECRET@@ -10,56 +21,41 @@     - 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.3 USE_COVERALLS=1 CABAL_FLAGS="-frun-integrated-test"-    - GHCVER=head  matrix:   allow_failures:     - env: GHCVER=7.4.2-    - env: GHCVER=head+    - env: GHCVER=7.6.3  before_install:-  - |-    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-    cabal install Cabal --constraint="Cabal >= 1.18 && < 1.19"+  - eval "$( curl -sL https://github.com/mietek/halcyon/raw/master/setup.sh )"+  - export HALCYON_GHC_VERSION=$GHCVER HALCYON_CABAL_VERSION=1.22.4.0+  - export HALCYON_S3_BUCKET=himura-halcyon  install:-  - export PATH=$HOME/.cabal/bin:$PATH-  - which cabal-  - travis_retry cabal update-  # GHC 7.8.3 exports transformers-0.3.0, but happy and our package installs transformers 0.4 series.-  # However, doctest fails when we have multiple version of transformers.-  # To prevent this, we restrict transformers version to (< 0.4)-  - 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+  - HALCYON_SANDBOX_EXTRA_APPS="hpc-coveralls happy" HALCYON_SANDBOX_EXTRA_CONFIGURE_FLAGS="--enable-tests --only-dependencies $CABAL_FLAGS" halcyon build+  - ln -s /app/sandbox/cabal.sandbox.config .  script:-  - |-    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 configure --enable-tests --enable-library-coverage $CABAL_FLAGS+  - travis_wait run-cabal-test --cabal-name=cabal --show-details=always++  # tests source distribution package+  - cabal sdist   - |-    if [ -n "$USE_COVERALLS" ]; then-      run-cabal-test --show-details=always-    else-      cabal test --show-details=always+    PKGNAME="$(cabal info . | awk '/^\*/{print $2}')"+    SRCTGZ="${PKGNAME}.tar.gz"+    cd dist/+    if [ -f "$SRCTGZ" ]; then+      tar xvzf "$SRCTGZ"+      cd "$PKGNAME"+      NG=$(git ls-tree HEAD --full-tree -r | while read perm blob hash name; do [ -e "$name" ] || echo NG "$name"; done)+      if [ -n "$NG" ]; then+        echo "Missing files:"+        echo $NG+        exit 1+      fi     fi  after_script:-  - "[ -n \"$USE_COVERALLS\" ] && hpc-coveralls --exclude-dir=tests spec_main || true"+  - hpc-coveralls --exclude-dir=tests tests

@@ -0,0 +1,3 @@+## 0.1.1++* Add `sourceWithSearchResult` and `sourceWithSearchResult'`

@@ -1,6 +1,7 @@ # twitter-conduit: An Conduit based Twitter API library for Haskell # -[![Build Status](https://travis-ci.org/himura/twitter-conduit.png?branch=master)](https://travis-ci.org/himura/twitter-conduit)+[![Travis](https://img.shields.io/travis/himura/twitter-conduit.svg)](https://travis-ci.org/himura/twitter-conduit)+[![Hackage-Deps](https://img.shields.io/hackage-deps/v/twitter-conduit.svg)](http://packdeps.haskellers.com/feed?needle=twitter-conduit)  ## About ## @@ -31,6 +32,7 @@ and then,  ~~~~+$ cabal install --only-dependencies -fbuild-samples $ cabal configure -fbuild-samples $ cabal build ~~~~

@@ -36,8 +36,10 @@        , sourceWithMaxId'        , sourceWithCursor        , sourceWithCursor'+       , sourceWithSearchResult+       , sourceWithSearchResult' -       -- * Backward compativility+       -- * Backward compatibility        -- $backward        ) where 

@@ -14,6 +14,8 @@        , sourceWithMaxId'        , sourceWithCursor        , sourceWithCursor'+       , sourceWithSearchResult+       , sourceWithSearchResult'        , TwitterBaseM        , endpoint        , makeRequest@@ -38,6 +40,8 @@ import qualified Data.Conduit as C import qualified Data.Conduit.Attoparsec as CA import qualified Data.Conduit.List as CL+import qualified Data.Map as M+import Data.Monoid import qualified Data.Text.Encoding as T import Network.HTTP.Client.MultipartFormData import qualified Network.HTTP.Conduit as HTTP@@ -283,6 +287,57 @@         res <- lift $ call info mgr $ relax $ req & cursor ?~ cur         CL.sourceList $ contents res         loop $ nextCursor res++-- | A wrapper function to perform multiple API request with @SearchResult@.+sourceWithSearchResult :: ( MonadResource m+                          , FromJSON responseType+                          , HasMaxIdParam (APIRequest apiName (SearchResult [responseType]))+                          )+                       => TWInfo -- ^ Twitter Setting+                       -> HTTP.Manager+                       -> APIRequest apiName (SearchResult [responseType])+                       -> m (SearchResult (C.Source m responseType))+sourceWithSearchResult info mgr req = do+    res <- call info mgr req+    let body = CL.sourceList (res ^. searchResultStatuses) <>+               loop (res ^. searchResultSearchMetadata . searchMetadataNextResults)+    return $ res & searchResultStatuses .~ body+  where+    origQueryMap = req ^. params . to M.fromList+    loop Nothing = CL.sourceNull+    loop (Just nextResultsStr) = do+        let nextResults = nextResultsStr & HT.parseSimpleQuery . T.encodeUtf8 & traversed . _2 %~ (PVString . T.decodeUtf8)+            nextParams = M.toList $ M.union (M.fromList nextResults) origQueryMap+        res <- call info mgr $ req & params .~ nextParams+        CL.sourceList (res ^. searchResultStatuses)+        loop $ res ^. searchResultSearchMetadata . searchMetadataNextResults++-- | A wrapper function to perform multiple API request with @SearchResult@.+sourceWithSearchResult' :: ( MonadResource m+                           , HasMaxIdParam (APIRequest apiName (SearchResult [responseType]))+                           )+                        => TWInfo -- ^ Twitter Setting+                        -> HTTP.Manager+                        -> APIRequest apiName (SearchResult [responseType])+                        -> m (SearchResult (C.Source m Value))+sourceWithSearchResult' info mgr req = do+    res <- call info mgr $ relax req+    let body = CL.sourceList (res ^. searchResultStatuses) <>+               loop (res ^. searchResultSearchMetadata . searchMetadataNextResults)+    return $ res & searchResultStatuses .~ body+  where+    origQueryMap = req ^. params . to M.fromList+    relax :: FromJSON value+          => APIRequest apiName (SearchResult responseType)+          -> APIRequest apiName (SearchResult value)+    relax = unsafeCoerce+    loop Nothing = CL.sourceNull+    loop (Just nextResultsStr) = do+        let nextResults = nextResultsStr & HT.parseSimpleQuery . T.encodeUtf8 & traversed . _2 %~ (PVString . T.decodeUtf8)+            nextParams = M.toList $ M.union (M.fromList nextResults) origQueryMap+        res <- call info mgr $ relax $ req & params .~ nextParams+        CL.sourceList (res ^. searchResultStatuses)+        loop $ res ^. searchResultSearchMetadata . searchMetadataNextResults  sinkJSON :: ( MonadThrow m             ) => C.Consumer ByteString m Value

@@ -31,7 +31,7 @@ -- see details: https://ghc.haskell.org/trac/ghc/ticket/5820 #if __GLASGOW_HASKELL__ >= 706 -- $setup--- >>> :set -XOverloadedStrings -XRank2Types -XEmptyDataDecls -XFlexibleInstances -XOverlappingInstances -XIncoherentInstances+-- >>> :set -XOverloadedStrings -XRank2Types -XEmptyDataDecls -XFlexibleInstances -- >>> import Control.Lens -- >>> import Data.Default -- >>> import Web.Twitter.Conduit.Parameters

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Web.Twitter.Conduit+import Web.Twitter.Types.Lens+import Common++import Control.Lens+import Control.Monad.IO.Class+import Data.Conduit+import qualified Data.Conduit.List as CL+import qualified Data.Text as T+import Network.HTTP.Conduit+import System.Environment++main :: IO ()+main = do+    [num, keyword] <- getArgs++    twInfo <- getTWInfoFromEnv++    withManager $ \mgr -> do+        res <- sourceWithSearchResult twInfo mgr $ searchTweets $ T.pack keyword+        let metadata = res ^. searchResultSearchMetadata+        liftIO . putStrLn $ "search completed in: " ++ metadata ^. searchMetadataCompletedIn . to show+        liftIO . putStrLn $ "search result max id: " ++ metadata ^. searchMetadataMaxId . to show+        res ^. searchResultStatuses $$ CL.isolate (read num) =$ CL.mapM_ (liftIO . print)

@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE PatternGuards #-}  import Web.Twitter.Conduit@@ -37,7 +36,7 @@     twInfo <- getTWInfoFromEnv     withManager $ \mgr -> do         src <- stream twInfo mgr userstream-        src C.$$+- CL.mapM_ (^! act (liftIO . printTL))+        src C.$$+- CL.mapM_ (liftIO . printTL)  showStatus :: AsStatus s => s -> T.Text showStatus s = T.concat [ s ^. user . userScreenName@@ -53,7 +52,7 @@                                                      ] printTL (SEvent event)     | (event^.evEvent) == "favorite" || (event^.evEvent) == "unfavorite",-      Just (ETStatus st) <- (event ^. evTargetObject) = do+      Just (ETStatus st) <- event ^. evTargetObject = do           let (fromUser, fromIcon) = evUserInfo (event^.evSource)               (toUser, _toIcon) = evUserInfo (event^.evTarget)               evUserInfo (ETUser u) = (u ^. userScreenName, u ^. userProfileImageURL)

@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++module BaseSpec where++import Web.Twitter.Conduit.Response+import Web.Twitter.Conduit.Base++import Control.Applicative+import Control.Lens+import Data.Aeson+import Data.Aeson.Lens+import Data.Conduit+import qualified Data.Conduit.Attoparsec as CA+import Data.Maybe+import qualified Data.Text as T+import qualified Network.HTTP.Types as HT++import Test.Hspec++spec :: Spec+spec = do+    unit++unit :: Spec+unit = do+    describe "checkResponse" $ do+        describe "when the response has \"errors\" key" $ do+            let errorMessage = fromJust . decode $ "{\"errors\":[{\"message\":\"Sorry, that page does not exist\",\"code\":34}]}"+                response = Response HT.status404 [] errorMessage+                result = checkResponse response++            it "returns TwitterErrorResponse" $ do+                case result of+                    Left res@(TwitterErrorResponse _ _ msgs) -> do+                        res `shouldBe` TwitterErrorResponse HT.status404 [] [TwitterErrorMessage 34 ""]+                        twitterErrorMessage (head msgs) `shouldBe` "Sorry, that page does not exist"+                    _ -> expectationFailure $ "Unexpected " ++ show result+        describe "when the response does not has \"errors\" key but have error status code" $ do+            let errorMessage = fromJust . decode $ "{}"+                response = Response HT.status404 [] errorMessage+                result = checkResponse response+            it "returns TwitterStatusError" $ do+                case result of+                    Left (TwitterStatusError st hdr body) -> do+                        st `shouldBe` HT.status404+                        hdr `shouldBe` []+                        body `shouldBe` errorMessage+                    _ -> expectationFailure $ "Unexpected " ++ show result++    describe "sinkJSON" $ do+        describe "when valid JSON input" $ do+            let input = "{\"test\": \"input\", \"status\": 200 }"+            it "can consume the input from Source and returns JSON Value" $ do+                res <- yield input $$ sinkJSON+                res ^. key "test" . _String `shouldBe` "input"+                res ^? key "status" . _Integer `shouldBe` Just 200+        describe "when invalid JSON input" $ do+            let input = "{]"+            it "should raise Data.Conduit.Attoparsec.ParseError" $ do+                let parseErrorException (CA.ParseError {}) = True+                    parseErrorException _ = False+                    action = yield input $$ sinkJSON+                action `shouldThrow` parseErrorException++    describe "sinkFromJSON" $ do+        describe "when valid JSON input" $ do+            let input = "{\"test\": \"input\", \"status\": 200 }"+            it "can consume the input from Source and returns a value which type is the specified one" $ do+                res <- yield input $$ sinkFromJSON+                res `shouldBe` TestJSON "input" 200+        describe "when the JSON value does not have expected format" $ do+            let input = "{\"status\": 200}"+            it "should raise FromJSONError" $ do+                let fromJSONException (FromJSONError {}) = True+                    fromJSONException _ = False+                    action :: IO TestJSON+                    action = yield input $$ sinkFromJSON+                action `shouldThrow` fromJSONException++data TestJSON = TestJSON+    { testField :: T.Text+    , testStatus :: Int+    } deriving (Show, Eq)+instance FromJSON TestJSON where+    parseJSON (Object o) =+        TestJSON <$> o .: "test"+                 <*> o .: "status"+    parseJSON v = fail $ "Unexpected: " ++ show v

@@ -6,6 +6,7 @@ import Control.Lens import Data.Conduit import qualified Data.Conduit.List as CL+import Data.Time import Network.HTTP.Conduit import System.IO.Unsafe import Web.Twitter.Conduit (call, accountVerifyCredentials, sourceWithMaxId, TWInfo)@@ -74,7 +75,7 @@             res <- withManager $ \mgr -> call twInfo mgr $ showId 477833886768959488             res ^. statusId `shouldBe` 477833886768959488             res ^. statusText `shouldBe` "真紅かわいいはアレセイア"-            res ^. statusCreatedAt `shouldBe` "Sat Jun 14 15:24:10 +0000 2014"+            res ^. statusCreatedAt `shouldBe` UTCTime (fromGregorian 2014 6 14) (secondsToDiffTime 55450)             res ^. statusUser . userScreenName `shouldBe` "thimura"      describe "update & destroyId" $ do

@@ -1,5 +1,5 @@ name:              twitter-conduit-version:           0.1.0+version:           0.1.1 license:           BSD3 license-file:      LICENSE author:            HATTORI Hiroki, Hideyuki Tanaka, Takahiro HIMURA@@ -25,7 +25,9 @@   .gitignore   .travis.yml   README.md+  ChangeLog.md   sample/*.hs+  tests/*.hs  source-repository head   type: git@@ -64,7 +66,7 @@     , aeson >= 0.7.0.5     , attoparsec >= 0.10     , data-default >= 0.3-    , bytestring >= 0.9+    , bytestring >= 0.10.2     , text >= 0.11     , containers     , time@@ -74,7 +76,7 @@   if flag(lens-aeson)     build-depends:         lens-aeson >= 1-      , lens >= 4.4 && < 4.5+      , lens >= 4.4   else     build-depends:         lens >= 4.0 && < 4.4@@ -159,6 +161,7 @@   other-modules:     Spec     ApiSpec+    BaseSpec     StatusSpec     TestUtils