module Web.GooglePlus (getPerson,
getActivity,
getComment,
getLatestActivityFeed,
enumActivityFeed,
getActivityFeed,
enumActivities,
getActivities,
enumPersonSearch,
getPersonSearch,
enumPeopleByActivity,
getPeopleByActivity,
enumActivitySearch,
getActivitySearch,
enumComments,
getComments,
SearchOrderBy(..),
ActivityCollection(..),
ListByActivityCollection(..)) where
import Web.GooglePlus.Types
import Web.GooglePlus.Monad
import Control.Applicative ((<$>), (<*>))
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (asks)
import Control.Monad.Trans.Class (lift)
import Data.Aeson (json,
FromJSON,
fromJSON,
parseJSON,
Result(..),
(.:),
(.:?),
Value(Object))
import Data.Aeson.Types (typeMismatch)
import Data.Attoparsec.Lazy (parse, eitherResult)
import Data.ByteString (ByteString, append)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import Data.Enumerator (Enumerator,
checkContinue1,
continue,
Stream (Chunks),
(>>==),
run_,
($$))
import qualified Data.Enumerator.List as EL
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Network.HTTP.Enumerator
import Network.HTTP.Types (Ascii, Query, QueryItem)
getPerson :: PersonID
-> GooglePlusM (Either Text Person)
getPerson pid = genericGet pth []
where pth = personIdPath pid
getActivity :: ID
-> GooglePlusM (Either Text Activity)
getActivity aid = genericGet pth []
where pth = "/plus/v1/activities/" `append` encodeUtf8 aid
getComment :: ID
-> GooglePlusM (Either Text Comment)
getComment cid = genericGet pth []
where pth = "/plus/v1/comments/" `append` encodeUtf8 cid
getLatestActivityFeed :: PersonID
-> ActivityCollection
-> Maybe Integer
-> GooglePlusM (Either Text ActivityFeed)
getLatestActivityFeed pid coll perPage = do
feed <- getActivityFeedPage pid coll (perPageActivity perPage) Nothing
return $ fst `fmap` feed
enumActivityFeed :: PersonID
-> ActivityCollection
-> Maybe Integer
-> Enumerator ActivityFeed GooglePlusM b
enumActivityFeed pid coll perPage = EL.unfoldM depaginate FirstPage
where depaginate = depaginateActivityFeed pid coll $ perPageActivity perPage
getActivityFeed :: PersonID
-> ActivityCollection
-> GooglePlusM ActivityFeed
getActivityFeed pid coll = do
feeds <- run_ $ enumActivityFeed pid coll (Just 100) $$ EL.consume
return $ foldl1 mergeFeeds feeds
where mergeFeeds a ActivityFeed { activityFeedItems = is} = a { activityFeedItems = activityFeedItems a ++ is }
enumActivities :: PersonID
-> ActivityCollection
-> Maybe Integer
-> Enumerator Activity GooglePlusM b
enumActivities pid coll perPage = simpleDepaginator depaginate
where depaginate = simpleDepaginationStep perPage' pth params
pth = pidP `append` actP
actP = "/activities/" `append` collectionPath coll
pidP = personIdPath pid
params = []
perPage' = perPageActivity perPage
getActivities :: PersonID
-> ActivityCollection
-> GooglePlusM [Activity]
getActivities pid coll = run_ $ enumActivities pid coll (Just 100) $$ EL.consume
enumPersonSearch :: Text
-> Maybe Integer
-> Enumerator PersonSearchResult GooglePlusM b
enumPersonSearch search perPage = simpleDepaginator depaginate
where depaginate = simpleDepaginationStep perPage' pth params
pth = "/plus/v1/people"
params = [("query", Just $ encodeUtf8 search)]
perPage' = perPageSearch perPage
getPersonSearch :: Text
-> GooglePlusM [PersonSearchResult]
getPersonSearch search = run_ $ enumPersonSearch search (Just 20) $$ EL.consume
enumPeopleByActivity :: ID
-> ListByActivityCollection
-> Maybe Integer
-> Enumerator Person GooglePlusM b
enumPeopleByActivity aid coll perPage = simpleDepaginator depaginate
where depaginate = simpleDepaginationStep perPage' pth params
pth = "/plus/v1/activities/" `append` encodeUtf8 aid `append` peopleP `append` collP coll
peopleP = "/people/"
collP PlusOners = "plusoners"
collP Resharers = "resharers"
params = []
perPage' = perPageActivity perPage
getPeopleByActivity :: ID
-> ListByActivityCollection
-> GooglePlusM [Person]
getPeopleByActivity aid coll = run_ $ enumPeopleByActivity aid coll (Just 100) $$ EL.consume
enumActivitySearch :: Text
-> SearchOrderBy
-> Maybe Integer
-> Enumerator Activity GooglePlusM b
enumActivitySearch search orderBy perPage = simpleDepaginator depaginate
where depaginate = simpleDepaginationStep perPage' pth params
pth = "/plus/v1/activities"
params = [("query", Just $ encodeUtf8 search),
("orderBy", Just $ orderParam orderBy)]
orderParam Best = "best"
orderParam Recent = "recent"
perPage' = perPageSearch perPage
getActivitySearch :: Text
-> SearchOrderBy
-> GooglePlusM [Activity]
getActivitySearch search orderBy = run_ $ enumActivitySearch search orderBy (Just 20) $$ EL.consume
enumComments :: ID
-> Maybe Integer
-> Enumerator Comment GooglePlusM b
enumComments aid perPage = simpleDepaginator depaginate
where depaginate = simpleDepaginationStep perPage' pth params
pth = "/plus/v1/activities/" `append` encodeUtf8 aid `append` "/comments"
params = []
perPage' = perPageActivity perPage
getComments :: ID
-> GooglePlusM [Comment]
getComments aid = run_ $ enumComments aid (Just 100) $$ EL.consume
data ActivityCollection = PublicCollection deriving (Show, Eq)
data ListByActivityCollection = PlusOners |
Resharers
deriving (Show, Eq)
data SearchOrderBy = Best |
Recent
deriving (Show, Eq)
simpleDepaginator :: Monad m => (DepaginationState -> m (Maybe ([a], DepaginationState)))
-> Enumerator a m b
simpleDepaginator depaginate = unfoldListM depaginate FirstPage
perPageActivity :: Maybe Integer
-> Integer
perPageActivity = fromMaybe 20
perPageSearch :: Maybe Integer
-> Integer
perPageSearch = fromMaybe 10
type PageToken = Text
type PaginatedActivityFeed = (ActivityFeed, Maybe PageToken)
instance FromJSON PaginatedActivityFeed where
parseJSON (Object v) = (,) <$> parseJSON (Object v)
<*> v .:? "nextPageToken"
parseJSON v = typeMismatch "PaginatedActivityFeed" v
data DepaginationState = FirstPage |
MorePages PageToken |
NoMorePages
unfoldListM :: Monad m => (s -> m (Maybe ([a], s)))
-> s
-> Enumerator a m b
unfoldListM f = checkContinue1 $ \loop s k -> do
fs <- lift (f s)
case fs of
Nothing -> continue k
Just (as, s') -> k (Chunks as) >>== loop s'
simpleGetFirstPage :: FromJSON a => Integer
-> Ascii
-> Query
-> GooglePlusM (Maybe (PaginatedResource a))
simpleGetFirstPage perPage = simpleGetPage perPage Nothing
simpleGetPage :: FromJSON a => Integer
-> Maybe PageToken
-> Ascii
-> Query
-> GooglePlusM (Maybe (PaginatedResource a))
simpleGetPage perPage tok pth params = do
page <- genericGet pth $ params ++ pageParams
return $ eitherMaybe page
where pageParam = BS8.pack . show $ perPage
pageParams = case tok of
Nothing -> [("maxResults", Just pageParam)]
Just t -> [("maxResults", Just pageParam), ("pageToken", Just $ encodeUtf8 t)]
simpleDepaginationStep :: FromJSON a => Integer
-> Ascii
-> Query
-> DepaginationState
-> GooglePlusM (Maybe ([a], DepaginationState))
simpleDepaginationStep perPage pth params FirstPage = (return . fmap paginatedState) =<< simpleGetFirstPage perPage pth params
simpleDepaginationStep perPage pth params (MorePages tok) = (return . fmap paginatedState) =<< simpleGetPage perPage (Just tok) pth params
simpleDepaginationStep _ _ _ NoMorePages = return Nothing
depaginateActivityFeed :: PersonID
-> ActivityCollection
-> Integer
-> DepaginationState
-> GooglePlusM (Maybe (ActivityFeed, DepaginationState))
depaginateActivityFeed pid coll perPage FirstPage = do
page <- getFirstFeedPage pid coll perPage
return $ paginatedState `fmap` page
depaginateActivityFeed pid coll perPage (MorePages tok) = do
page <- getActivityFeedPage pid coll perPage $ Just tok
return $ paginatedState `fmap` eitherMaybe page
depaginateActivityFeed _ _ _ NoMorePages = return Nothing
getFirstFeedPage :: PersonID
-> ActivityCollection
-> Integer
-> GooglePlusM (Maybe PaginatedActivityFeed)
getFirstFeedPage pid coll perPage = do
page <- getActivityFeedPage pid coll perPage Nothing
return $ eitherMaybe page
getActivityFeedPage :: PersonID
-> ActivityCollection
-> Integer
-> Maybe PageToken
-> GooglePlusM (Either Text PaginatedActivityFeed)
getActivityFeedPage pid coll perPage tok = genericGet pth params
where pth = pidP `append` actP
pidP = personIdPath pid
actP = "/activities/" `append` collectionPath coll
pageParam = BS8.pack . show $ perPage
params = case tok of
Nothing -> [("maxResults", Just pageParam)]
Just t -> [("maxResults", Just pageParam), ("pageToken", Just $ encodeUtf8 t)]
type PaginatedResource a = ([a], Maybe PageToken)
instance FromJSON a => FromJSON (PaginatedResource a) where
parseJSON (Object v) = (,) <$> v .: "items"
<*> v .:? "nextPageToken"
parseJSON v = typeMismatch "PaginatedResource" v
paginatedState :: (a, Maybe PageToken)
-> (a, DepaginationState)
paginatedState (results, token) = (results, maybe NoMorePages MorePages token)
eitherMaybe :: Either a b
-> Maybe b
eitherMaybe (Left _) = Nothing
eitherMaybe (Right x) = Just x
genericGet :: FromJSON a => Ascii
-> Query
-> GooglePlusM (Either Text a)
genericGet pth qs = withEnv $ \auth -> return . handleResponse =<< doGet auth pth qs
collectionPath :: ActivityCollection
-> ByteString
collectionPath PublicCollection = "public"
personIdPath :: PersonID
-> ByteString
personIdPath (PersonID i) = "/plus/v1/people/" `append` encodeUtf8 i
personIdPath Me = "/plus/v1/people/me"
doGet :: GooglePlusAuth
-> Ascii
-> Query
-> GooglePlusM (Int, LBS.ByteString)
doGet auth pth q = liftIO $ withManager $ \manager -> do
Response { statusCode = c, responseBody = b} <- httpLbsRedirect req manager
return (c, b)
where req = genRequest auth pth q
genRequest :: GooglePlusAuth
-> Ascii
-> Query
-> Request m
genRequest auth pth q = def { host = h,
path = pth,
port = 443,
secure = True,
queryString = q' }
where h = "www.googleapis.com"
authq = authParam auth
q' = authq:q
authParam :: GooglePlusAuth
-> QueryItem
authParam (APIKey key) = ("key", Just $ encodeUtf8 key)
authParam (OAuthToken tok) = ("access_token", Just $ encodeUtf8 tok)
handleResponse :: FromJSON a => (Int, LBS.ByteString)
-> Either Text a
handleResponse (200, str) = packLeft $ fjson =<< parsed
where fjson v = case fromJSON v of
Success a -> Right a
Error e -> Left e
parsed = eitherResult $ parse json str
handleResponse (_, str) = Left $ decodeUtf8 . BS.concat . LBS.toChunks $ str
packLeft :: Either String a
-> Either Text a
packLeft (Right x) = Right x
packLeft (Left str) = Left $ pack str
withEnv :: (GooglePlusAuth -> GooglePlusM a)
-> GooglePlusM a
withEnv fn = fn =<< asks gpAuth