diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2014 Justin Leitgeb
+Copyright (c) 2014 Stack Builders Inc.
MIT License
diff --git a/src/Web/Twitter/Feed.hs b/src/Web/Twitter/Feed.hs
--- a/src/Web/Twitter/Feed.hs
+++ b/src/Web/Twitter/Feed.hs
@@ -1,127 +1,43 @@
{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
module Web.Twitter.Feed
- ( Tweet
- , Link (..)
- , URLEntity (..)
- , UserEntity (..)
- , MediaEntity (..)
- , timeline
+ ( timeline
, addLink
, timelineUrl
, sortLinks
- )
-where
+ ) where
+import qualified Data.ByteString.Lazy as BS
+
import Network.HTTP.Conduit
import Web.Authenticate.OAuth
import Data.Aeson
-import GHC.Generics (Generic)
-import Control.Applicative
-import Data.List (sortBy)
-import Control.Monad (mzero)
+import Data.List (elemIndices, sort)
import Data.Char (toLower)
-
-type BoundingIndices = [Int]
-
-data SimpleTweet = SimpleTweet
- { body :: String
- , tweetId :: String
- , created_at :: String
- } deriving (Show, Generic)
-
-data Tweet = Tweet
- { text :: String
- , createdAt :: String
- , idStr :: String
- , entities :: Entities
- } deriving (Show, Generic)
-
-data UserEntity = UserEntity
- { screenName :: String
- , userIndices :: BoundingIndices
- } deriving (Show, Generic)
-
-data URLEntity = URLEntity
- { urlMessage :: String
- , urlIndices :: BoundingIndices
- , displayUrl :: String
- } deriving (Show, Generic)
-
-data MediaEntity = MediaEntity
- { mediaUrl :: String
- , mediaIndices :: BoundingIndices
- , displayMediaUrl :: String
- } deriving (Show, Generic)
-
-data Entities = Entities
- { userEntities :: [UserEntity]
- , urlEntities :: [URLEntity]
- , mediaEntities :: [MediaEntity]
- } deriving (Show, Generic)
-
-data Link = Link
- { startIndex :: Int
- , endIndex :: Int
- , newHtml :: String
- } deriving (Show, Eq)
-
-instance ToJSON SimpleTweet
-
-instance ToJSON Tweet
-instance FromJSON Tweet
- where parseJSON (Object v) = Tweet
- <$> v .: "text"
- <*> v .: "created_at"
- <*> v .: "id_str"
- <*> v .: "entities"
- parseJSON _ = mzero
-
-instance ToJSON UserEntity
-instance FromJSON UserEntity
- where parseJSON (Object v) = UserEntity
- <$> v .: "screen_name"
- <*> v .: "indices" .!= []
- parseJSON _ = mzero
-
-instance ToJSON URLEntity
-instance FromJSON URLEntity
- where parseJSON (Object v) = URLEntity
- <$> v .: "url"
- <*> v .: "indices" .!= []
- <*> v .: "display_url"
- parseJSON _ = mzero
-
-instance ToJSON MediaEntity
-instance FromJSON MediaEntity
- where parseJSON (Object v) = MediaEntity
- <$> v .: "url"
- <*> v .: "indices" .!= []
- <*> v .: "display_url"
- parseJSON _ = mzero
-
-instance ToJSON Entities
-instance FromJSON Entities
- where parseJSON (Object v) = Entities
- <$> v .:? "user_mentions" .!= []
- <*> v .:? "urls" .!= []
- <*> v .:? "media" .!= []
- parseJSON _ = mzero
+import Web.Twitter.Types
timeline :: OAuth -> Credential -> Int -> Bool -> String ->
IO (Either String [SimpleTweet])
timeline oauth credential count excludeReplies username = do
- req <- parseUrl $ timelineUrl username count excludeReplies
- res <- withManager $ \m -> do
- signedreq <- signOAuth oauth credential req
- httpLbs signedreq m
+ req <- createRequest username count excludeReplies
+ res <- getResponse oauth credential req
+ return $
+ case decodeTweets res of
+ Left message -> Left message
+ Right ts -> Right $ map (simplifyTweet . linkifyTweet) ts
- let decoded = decode $ responseBody res
+createRequest :: String -> Int -> Bool -> IO Request
+createRequest username count excludeReplies = parseUrl $ timelineUrl username count excludeReplies
- case decoded of
- Nothing -> return $ Left "Unable to retrieve tweets!"
- Just ts -> return $ Right $ map (simplifyTweet . linkifyTweet) ts
+getResponse :: OAuth -> Credential -> Request -> IO (Response BS.ByteString)
+getResponse oauth credential req =
+ withManager $ \m -> do
+ signedreq <- signOAuth oauth credential req
+ httpLbs signedreq m
+decodeTweets :: Response BS.ByteString -> Either String [Tweet]
+decodeTweets = eitherDecode . responseBody
+
timelineUrl :: String -> Int -> Bool -> String
timelineUrl user count excludeReplies =
"https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name=" ++
@@ -138,21 +54,17 @@
(entities tweet)
processText :: String -> [UserEntity] -> [URLEntity] -> [MediaEntity] -> String
-processText message users urls medias = foldr addLink message
- (sortLinks urls users medias)
+processText message users urls medias = foldr addLink message sortedLinks
+ where sortedLinks = sortLinks urls users medias
sortLinks :: [URLEntity] -> [UserEntity] -> [MediaEntity] -> [Link]
-sortLinks urls users medias = sortBy sortDesc (map makeURLLink urls ++
- map makeUserLink users ++
- map makeMediaLink medias)
- where sortDesc a b
- | startIndex a < startIndex b = LT
- | otherwise = GT
+sortLinks urls users medias = sort (map makeURLLink urls ++
+ map makeUserLink users ++
+ map makeMediaLink medias)
makeURLLink :: URLEntity -> Link
makeURLLink urlEntity = Link x y url
- where x = head (urlIndices urlEntity)
- y = urlIndices urlEntity !! 1
+ where (x, y) = urlIndices urlEntity
urlText = displayUrl urlEntity
href = urlMessage urlEntity
url = ""
@@ -160,8 +72,7 @@
makeMediaLink :: MediaEntity -> Link
makeMediaLink mediaEntity = Link x y url
- where x = head (mediaIndices mediaEntity)
- y = mediaIndices mediaEntity !! 1
+ where (x, y) = mediaIndices mediaEntity
urlText = displayMediaUrl mediaEntity
href = mediaUrl mediaEntity
url = ""
@@ -169,8 +80,7 @@
makeUserLink :: UserEntity -> Link
makeUserLink userEntity = Link x y mention
- where x = head (userIndices userEntity)
- y = userIndices userEntity !! 1
+ where (x, y) = userIndices userEntity
username = screenName userEntity
mention = "@" ++ username ++ ""
@@ -182,6 +92,10 @@
, created_at = createdAt tweet }
addLink :: Link -> String -> String
-addLink link tweet = before ++ newHtml link ++ after
- where before = fst (splitAt (startIndex link) tweet)
- after = snd (splitAt (endIndex link) tweet)
+addLink (Link 139 140 link) tweet = before ++ " " ++ link ++ after
+ where before = fst (splitAt (lastBlank tweet) tweet)
+ after = snd (splitAt 140 tweet)
+ lastBlank = last . elemIndices ' '
+addLink (Link start end link) tweet = before ++ link ++ after
+ where before = fst (splitAt start tweet)
+ after = snd (splitAt end tweet)
diff --git a/src/Web/Twitter/Types.hs b/src/Web/Twitter/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Twitter/Types.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Web.Twitter.Types
+ ( Tweet(..)
+ , SimpleTweet(..)
+ , Link(..)
+ , Entities(..)
+ , URLEntity(..)
+ , UserEntity(..)
+ , MediaEntity(..)
+ ) where
+
+import Control.Applicative
+import Data.Aeson
+import Data.Aeson.Types
+import Data.Ord (comparing)
+import GHC.Generics (Generic)
+
+type BoundingIndices = (Int, Int)
+
+data SimpleTweet = SimpleTweet
+ { body :: String
+ , tweetId :: String
+ , created_at :: String
+ } deriving (Show, Generic)
+
+data Tweet = Tweet
+ { text :: String
+ , createdAt :: String
+ , idStr :: String
+ , entities :: Entities
+ } deriving (Show, Generic)
+
+data Entities = Entities
+ { userEntities :: [UserEntity]
+ , urlEntities :: [URLEntity]
+ , mediaEntities :: [MediaEntity]
+ } deriving (Show, Generic)
+
+data UserEntity = UserEntity
+ { screenName :: String
+ , userIndices :: BoundingIndices
+ } deriving (Show, Generic)
+
+data URLEntity = URLEntity
+ { urlMessage :: String
+ , urlIndices :: BoundingIndices
+ , displayUrl :: String
+ } deriving (Show, Generic)
+
+data MediaEntity = MediaEntity
+ { mediaUrl :: String
+ , mediaIndices :: BoundingIndices
+ , displayMediaUrl :: String
+ } deriving (Show, Generic)
+
+data Link = Link
+ { startIndex :: Int
+ , endIndex :: Int
+ , newHtml :: String
+ } deriving (Show, Eq)
+
+instance ToJSON SimpleTweet
+
+instance ToJSON Tweet
+instance FromJSON Tweet where
+ parseJSON = withObject "Tweet" parseTweet
+
+instance ToJSON Entities
+instance FromJSON Entities where
+ parseJSON = withObject "Entities" parseEntities
+
+instance ToJSON UserEntity
+instance FromJSON UserEntity where
+ parseJSON = withObject "UserEntity" parseUserEntity
+
+instance ToJSON URLEntity
+instance FromJSON URLEntity where
+ parseJSON = withObject "URLEntity" parseURLEntity
+
+instance ToJSON MediaEntity
+instance FromJSON MediaEntity where
+ parseJSON = withObject "MediaEntity" parseMediaEntity
+
+instance Ord Link where
+ compare = comparing startIndex
+
+parseTweet :: Object -> Parser Tweet
+parseTweet v = Tweet <$> v .: "text"
+ <*> v .: "created_at"
+ <*> v .: "id_str"
+ <*> v .: "entities"
+
+parseUserEntity :: Object -> Parser UserEntity
+parseUserEntity v = UserEntity <$> v .: "screen_name"
+ <*> v .: "indices"
+
+parseURLEntity :: Object -> Parser URLEntity
+parseURLEntity v = URLEntity <$> v .: "url"
+ <*> v .: "indices"
+ <*> v .: "display_url"
+
+parseMediaEntity :: Object -> Parser MediaEntity
+parseMediaEntity v = MediaEntity <$> v .: "url"
+ <*> v .: "indices"
+ <*> v .: "display_url"
+
+parseEntities :: Object -> Parser Entities
+parseEntities v = Entities <$> v .:? "user_mentions" .!= []
+ <*> v .:? "urls" .!= []
+ <*> v .:? "media" .!= []
diff --git a/twitter-feed.cabal b/twitter-feed.cabal
--- a/twitter-feed.cabal
+++ b/twitter-feed.cabal
@@ -1,5 +1,5 @@
name: twitter-feed
-version: 0.1.1.1
+version: 0.1.1.2
synopsis: Client for fetching Twitter timeline via Oauth
description: Fetches a user timeline from Twitter, and optionally linkifies the results using the Twitter entity API.
homepage: https://github.com/stackbuilders/twitter-feed
@@ -18,28 +18,30 @@
library
exposed-modules: Web.Twitter.Feed
+ Web.Twitter.Types
ghc-options: -Wall
- build-depends: base >=4.6 && <4.8
- , authenticate-oauth >=1.4
- , aeson >=0.7 && <0.8
- , http-conduit >=1.4 && <2.0
+ build-depends:
+ base >= 4.6 && < 4.8,
+ aeson >= 0.8 && < 0.9,
+ authenticate-oauth >= 1.5 && < 1.6,
+ http-conduit >= 2.1.4 && < 2.1.5,
+ bytestring >= 0.10 && < 0.11
+
hs-source-dirs: src
default-language: Haskell2010
test-suite twitter-library
type: exitcode-stdio-1.0
- hs-source-dirs: test, src
+ hs-source-dirs: test
main-is: Suite.hs
build-depends:
- base >=4.6 && <4.8
- , test-framework >=0.8 && <0.9
- , HUnit
- , test-framework-hunit
- , containers
-
- , authenticate-oauth >=1.4
- , aeson >=0.7 && <0.8
- , http-conduit >=1.4 && <2.0
+ base,
+ twitter-feed,
+ containers >= 0.5 && < 0.6,
+ HUnit >= 1.2 && < 1.3,
+ test-framework >= 0.8 && < 0.9,
+ test-framework-hunit >= 0.3 && < 0.4
default-language: Haskell2010
+ ghc-options: -Wall