googleplus-0.2.1: Web/GooglePlus.hs
--------------------------------------------------------------------
-- |
-- Module : Web.GooglePlus
-- Description : Toplevel module for the Google+ API
-- Copyright : (c) Michael Xavier 2011
-- License : MIT
--
-- Maintainer: Michael Xavier <michael@michaelxavier.net>
-- Stability : provisional
-- Portability: portable
--
-- Toplevel module for the Google+ API operating in the GooglePlusM Monad.
-- Currently covers the (very) limited, read-only API that Google has exposed
-- in v1 of the Google+ API
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > import Web.GooglePlus
-- > import Web.GooglePlus.Monad
-- > import Web.GooglePlus.Types
-- > import Control.Monad.Reader
-- > import Data.Text (unpack)
-- >
-- > doStuff :: GooglePlusM ()
-- > doStuff = do
-- > Right person <- getPerson Me
-- > Right feed <- getLatestActivityFeed Me PublicCollection
-- > -- ...
-- > return ()
-- >
-- > main :: IO ()
-- > main = do
-- > runReaderT (unGooglePlusM doStuff) env
-- > where env = GooglePlusEnv { gpAuth = APIKey "MYKEY" }
--
--------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings, FlexibleContexts, TypeSynonymInstances #-}
module Web.GooglePlus (getPerson,
getActivity,
getLatestActivityFeed,
enumActivityFeed,
enumActivities) 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,
joinI,
checkContinue1,
continue,
Stream (Chunks),
(>>==),
($=),
($$))
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)
-- | Get a person who matches the given identifier
getPerson :: PersonID -- ^ Identifier for the person to fetch
-> GooglePlusM (Either Text Person)
getPerson pid = genericGet pth []
where pth = personIdPath pid
-- | Get an activity who matches the given activity ID
getActivity :: ID -- ^ Specific ID to fetch
-> GooglePlusM (Either Text Activity)
getActivity aid = genericGet pth []
where pth = append "/plus/v1/activities/" $ encodeUtf8 aid
-- | Get an activity who matches the given activity ID and collection to use.
-- Default page size is (20) and only fetches the first page.
-- You will receive an error from the server if the page size exceeds 100.
getLatestActivityFeed :: PersonID -- ^ Feed owner ID
-> ActivityCollection -- ^ Indicates what type of feed to retrieve
-> Maybe Integer -- ^ Page size. Should be between 1 and 100. Default 20.
-> GooglePlusM (Either Text ActivityFeed)
getLatestActivityFeed pid coll perPage = do
feed <- getActivityFeedPage pid coll (perPage' perPage) Nothing
return $ fst `fmap` feed
-- | Paginating enumerator to consume a user's activity stream. Each chunk will
-- end up being an array with a single ActivityFeed in it with 1 page of data
-- in it. This weirdness about the chunks only containing 1 element is mostly
-- to maintain the metadata available on ActivityFeed and have it available in
-- each chunk. For a more natural chunking of just Activities if you don't need
-- that additional metadata, see enumActivities. Note that this Enumerator will
-- abort if it encounters an error from the server, thus cutting the list
-- short.
enumActivityFeed :: PersonID -- ^ Feed owner ID
-> ActivityCollection -- ^ Indicates what type of feed to retrieve
-> Maybe Integer -- ^ Page size. Should be between 1 and 100. Defualt 20
-> Enumerator ActivityFeed GooglePlusM b
enumActivityFeed pid coll perPage = EL.unfoldM depaginate FirstPage
where depaginate = depaginateActivityFeed pid coll $ perPage' perPage
-- | Paginating enumerator yielding a Chunk for each page. Use this if you
-- don't need the feed metadata that enumActivityFeed provides.
enumActivities :: PersonID -- ^ Feed owner ID
-> ActivityCollection -- ^ Indicates what type of feed to retrieve
-> Maybe Integer -- ^ Page size. Should be between 1 and 100. Defualt 20
-> Enumerator Activity GooglePlusM b
enumActivities pid coll perPage = unfoldListM depaginate FirstPage
where depaginate = depaginateActivities pid coll (perPage' perPage)
---- Helpers
perPage' :: Maybe Integer -> Integer
perPage' = fromMaybe defaultPageSize
defaultPageSize :: Integer
defaultPageSize = 20
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
-- Exactly the same as unfoldM but takes the result of the stateful function
-- and uses it as the chunks, rather than a Chunks with a singleton list
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'
depaginateActivities:: PersonID -> ActivityCollection -> Integer -> DepaginationState -> GooglePlusM (Maybe ([Activity], DepaginationState))
depaginateActivities pid coll perPage state = (return . (fmap unwrap)) =<< depaginateActivityFeed pid coll perPage state
where unwrap (feed, s) = (activityFeedItems feed, s)
depaginateActivityFeed :: PersonID -> ActivityCollection -> Integer -> DepaginationState -> GooglePlusM (Maybe (ActivityFeed, DepaginationState))
depaginateActivityFeed pid coll perPage FirstPage = do
page <- getFirstFeedPage pid coll perPage
return $ paginatedFeedState `fmap` page
depaginateActivityFeed pid coll perPage (MorePages tok) = do
page <- getActivityFeedPage pid coll perPage $ Just tok
return $ paginatedFeedState `fmap` eitherMaybe page
depaginateActivityFeed _ _ _ NoMorePages = return Nothing
paginatedFeedState :: PaginatedActivityFeed -> (ActivityFeed, DepaginationState)
paginatedFeedState (feed, token) = (feed, maybe NoMorePages MorePages token)
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 = append pidP actP
pidP = personIdPath pid
actP = append "/activities/" $ collectionPath coll
pageParam = BS8.pack . show $ perPage
params = case tok of
Nothing -> [("maxResults", Just pageParam)]
Just t -> [("maxResults", Just pageParam), ("pageToken", Just $ encodeUtf8 t)]
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 -> do
resp <- doGet auth pth qs
return $ handleResponse resp
collectionPath :: ActivityCollection -> ByteString
collectionPath PublicCollection = "public"
personIdPath :: PersonID -> ByteString
personIdPath (PersonID i) = append "/plus/v1/people/" $ 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