diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +The following license covers this documentation, and the source code, except +where otherwise indicated. + +Copyright 2011, Michael Xavier. All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO +EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE +OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,40 @@ +Web.GooglePlus +------------ + +Haskell implementation of the GooglePlus api. For more info, see +http://developers.google.com/+/api/ + +Installation +------------ +Requires that you have cabal installed. I've included a Makefile for convenience. To install run `make install` + +Alternatively, you can install this from Hackage: +`cabal install googleplus` + +Documentation +------------- +`make doc` will generate a doc directory. Point your browser at the index.html to see the Haddock documentation. + + +Brief Example +------------- +This example is included in the documentation of the Web.GooglePlus: + + {-# 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 <- getActivityFeed Me PublicCollection + -- ... + return () + + main :: IO () + main = do + runReaderT (unGooglePlusM doStuff) env + where env = GooglePlusEnv { gpAuth = APIKey "MYKEY" } diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,8 @@ +#!/usr/bin/env runhaskell + +> module Main where +> import Distribution.Simple + +> main :: IO () +> main = defaultMain + diff --git a/Web/GooglePlus.hs b/Web/GooglePlus.hs new file mode 100644 --- /dev/null +++ b/Web/GooglePlus.hs @@ -0,0 +1,126 @@ +-------------------------------------------------------------------- +-- | +-- Module : Web.GooglePlus +-- Description : Toplevel module for the Google+ API +-- Copyright : (c) Michael Xavier 2011 +-- License : MIT +-- +-- Maintainer: Michael Xavier +-- 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 <- getActivityFeed Me PublicCollection +-- > -- ... +-- > return () +-- > +-- > main :: IO () +-- > main = do +-- > runReaderT (unGooglePlusM doStuff) env +-- > where env = GooglePlusEnv { gpAuth = APIKey "MYKEY" } +-- +-------------------------------------------------------------------- + +{-# LANGUAGE OverloadedStrings #-} +module Web.GooglePlus (getPerson, getActivity, getActivityFeed) where + +import Web.GooglePlus.Types +import Web.GooglePlus.Monad + +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Reader (asks) +import Data.Aeson (json, FromJSON, fromJSON, Result(..)) +import Data.Attoparsec.Lazy (parse, eitherResult) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import Data.ByteString (append) +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 -> GooglePlusM (Either Text Person) +getPerson pid = genericGet pth [] + where pth = personIdPath pid + + +-- | Get an activity who matches the given activity ID +getActivity :: ID -> GooglePlusM (Either Text Activity) +getActivity aid = genericGet pth [] + where pth = append "/plus/v1/activities/" $ encodeUtf8 aid + +--TODO: pagetoken, pagination, limits, enumerator? + +-- | Get an activity who matches the given activity ID and collection to use. +-- Currently uses the default page size (20) and only fetches the first page. I +-- plan to add pagination fairly soon and possibly an enumerator a bit later +getActivityFeed :: PersonID -> ActivityCollection -> GooglePlusM (Either Text ActivityFeed) +getActivityFeed pid coll = genericGet pth [] + where pth = append pidP actP + pidP = personIdPath pid + actP = append "/activities/" $ collectionPath coll + +---- Helpers + +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 diff --git a/Web/GooglePlus/Monad.hs b/Web/GooglePlus/Monad.hs new file mode 100644 --- /dev/null +++ b/Web/GooglePlus/Monad.hs @@ -0,0 +1,32 @@ +-------------------------------------------------------------------- +-- | +-- Module : Web.GooglePlus.Monad +-- Description : Monadic interface for communcating with the Google+ API +-- Copyright : (c) Michael Xavier 2011 +-- License : MIT +-- +-- Maintainer: Michael Xavier +-- Stability : provisional +-- Portability: portable +-- +-------------------------------------------------------------------- + +{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-} +module Web.GooglePlus.Monad where + +import Data.Text (Text) +import Control.Monad.Reader + +-- |Represents authentication data with GooglePlus. Currently supports an OAuth +-- token or an API key +data GooglePlusAuth = APIKey Text | -- ^ Authentication using an API key + OAuthToken Text -- ^ Authenticate using a token obtianed via OAuth V2. Currently no way in the library to obtain refresh tokens + +--TODO: getting tokens and using refresh tokens + +-- |Environment passed into requests when they are executed within a GooglePlusM +data GooglePlusEnv = GooglePlusEnv { gpAuth :: GooglePlusAuth } + +-- |IO wrapper used to compose/sequence Google+ API actions. See Web.GooglePlus docs for examples +newtype GooglePlusM a = GooglePlusM {unGooglePlusM :: ReaderT GooglePlusEnv IO a} + deriving (Monad, MonadIO, MonadReader GooglePlusEnv) diff --git a/Web/GooglePlus/Types.hs b/Web/GooglePlus/Types.hs new file mode 100644 --- /dev/null +++ b/Web/GooglePlus/Types.hs @@ -0,0 +1,533 @@ +-------------------------------------------------------------------- +-- | +-- Module : Web.GooglePlus.Types +-- Description : Types returned by the Google+ API +-- Copyright : (c) Michael Xavier 2011 +-- License : MIT +-- +-- Maintainer: Michael Xavier +-- Stability : provisional +-- Portability: portable +-- +-------------------------------------------------------------------- + +{-# LANGUAGE OverloadedStrings #-} +module Web.GooglePlus.Types (Person(..), + PersonID(..), + ActivityCollection(..), + ID, + Actor(..), + Verb(..), + ActivityObject(..), + ActivityObjectType(..), + Provider(..), + Access(..), + AccessItem(..), + AccessItemType(..), + Geocode(..), + Activity(..), + ActivityFeed(..), + Attachment(..), + AttachmentType(..), + Embed(..), + Gender(..), + PersonName(..), + Image(..), + Email(..), + EmailType(..), + PersonURL(..), + PersonURLType(..), + Organization(..), + OrganizationType(..), + Place(..), + RelationshipStatus(..)) where + +import Data.Aeson.Types (Parser, typeMismatch) +import Control.Applicative ((<$>), (<*>), pure) +import Data.Aeson (Value(..), + Object, + FromJSON, + parseJSON, + (.:), + (.:?)) +import qualified Data.Map as M +import Data.Time.Calendar (Day(..)) +import Data.Time.LocalTime (ZonedTime(..), zonedTimeToUTC) +import Data.Time.RFC3339 (readRFC3339) +import Data.Text (Text, unpack) +import qualified Data.Text as T +import Network.URL (URL(..), importURL) + +type ID = Text + +---------- Activity Types + +-- |A feed of user activity +data ActivityFeed = ActivityFeed { activityFeedTitle :: Text, -- ^ Title of the feed in Google+ + activityFeedUpdated :: ZonedTime, -- ^ Time updated + activityFeedId :: ID, -- ^ Unique ID of the feed + activityFeedItems :: [Activity] -- ^ Activities in the feed (currently limited to first page + } deriving (Show, Eq) + +-- |Specifies the type of Activities to get. Currently the API only allows public. +data ActivityCollection = PublicCollection deriving (Show, Eq) + +instance FromJSON ActivityFeed where + parseJSON (Object v) = ActivityFeed <$> v .: "title" + <*> v .: "updated" + <*> v .: "id" + <*> v .: "items" + parseJSON v = typeMismatch "ActivityFeed" v + +-- |Activity on Google+, such as a post +data Activity = Activity { activityPlaceholder :: Maybe Bool, -- ^ Meaning undocumented + activityTitle :: Text, -- ^ Title of the activity + activityPublished :: ZonedTime, -- ^ Date originally published + activityUpdated :: ZonedTime, -- ^ Date updated + activityId :: ID, -- ^ Activity ID + activityURL :: URL, -- ^ URL to view the Activity + activityActor :: Actor, -- ^ The person who performed the Activity + activityVerb :: Verb, -- ^ Indicates what action was performed + activityObject :: ActivityObject, -- ^ The object of the Activity + activityAnnotation :: Maybe Text, -- ^ Additional content added by the person who shared this activity, applicable only when resharing an activity + activityCrosspostSource :: Maybe ID, -- ^ ID of original activity if this activity is a crosspost from another system + activityProvider :: Provider, -- ^ Service provider initially providing the activity + activityAccess :: Access, -- ^ Identifies who has access to this activity + activityGeocode :: Maybe Geocode, -- ^ Where the activity occurred (Latitude/Longitude) + activityAddress :: Maybe Text, -- ^ Street address where the activity occurred + activityRadius :: Maybe Integer, -- ^ Radius of the region where the activity ocurred, centered at the Geocode + activityPlaceId :: Maybe ID, -- ^ ID of the place where the activity occurred + activityPlaceName :: Maybe Text + } deriving (Show, Eq) + +--TODO: activities +instance FromJSON Activity where + parseJSON (Object v) = Activity <$> v .:? "placeholder" + <*> v .: "title" + <*> v .: "published" + <*> v .: "updated" + <*> v .: "id" + <*> v .: "url" + <*> v .: "actor" + <*> v .:| ("verb", Post) + <*> v .: "object" + <*> v .:? "annotation" + <*> v .:? "crosspostSource" + <*> v .: "provider" + <*> v .: "access" + <*> v .:? "geocode" + <*> v .:? "address" + <*> v .:? "radius" + <*> v .:? "placeId" + <*> v .:? "placeName" + parseJSON v = typeMismatch "Activity" v + +instance Eq ZonedTime where + a == b = zonedTimeToUTC a == zonedTimeToUTC b + +instance FromJSON ZonedTime where + parseJSON (String str) = maybe (fail $ "Failed to parse ZonedTime " ++ unpack str) pure parsed + where parsed = readRFC3339 . unpack $ str + parseJSON v = typeMismatch "ZonedTime" v + + +-- |A person who may be associated with an Activity +data Actor = Actor { actorDisplayName :: Text, -- ^ The public display name of the Actor + actorId :: ID, -- ^ The ID of the Actor + actorImage :: Image, -- ^ Data pertaining to the Actor's main profile image + actorUrl :: URL -- ^ URL of the user's profile + } deriving (Show, Eq) + +instance FromJSON Actor where + parseJSON (Object v) = Actor <$> v .: "displayName" + <*> v .: "id" + <*> v .: "image" + <*> v .: "url" + parseJSON v = typeMismatch "Actor" v + +-- |Type of activity being performed +data Verb = Post | -- ^ Publish content to the stream + Checkin | -- ^ Check into a location + Share -- ^ Reshare an activity + deriving (Show, Eq) + +instance FromJSON Verb where + parseJSON (String "post") = pure Post + parseJSON (String "checkin") = pure Checkin + parseJSON (String "share") = pure Share + parseJSON v = typeMismatch "Verb" v + +-- |Object to which an activity pertains +data ActivityObject = ActivityObject { activityObjectActor :: Maybe Actor, -- ^ If the object is another Activity, this refers to the actor for that Activity + activityObjectAttachments :: [Attachment], -- ^ Media objects attached to this activity object + activityObjectContent :: Text, -- ^ Snipped of text if the object is an article + activityObjectId :: Maybe ID, -- ^ ID of the media object's resource + activityObjectType :: ActivityObjectType, -- ^ Type of Object + activityObjectOriginalContent :: Maybe Text, -- ^ Content text as provided by the author without any HTML formatting + activityObjectPlusOners :: Integer, -- ^ Number of people giving the Activity a +1 + activityObjectReplies :: Integer, -- ^ Number of replies to the Activity + activityObjectResharers :: Integer, -- ^ Number of people resharing the Activity + activityObjectURL :: URL -- ^ URL pointing to the linked resource + } deriving (Show, Eq) + +instance FromJSON ActivityObject where + parseJSON (Object v) = ActivityObject <$> v .:? "actor" + <*> v .:| ("attachments", []) + <*> v .: "content" + <*> v .:? "id" + <*> v .:| ("objectType", Note) + <*> v .:? "originalContent" + <*> parseTotalItems "plusoners" + <*> parseTotalItems "replies" + <*> parseTotalItems "resharers" + <*> v .: "url" + where parseTotalItems key = maybe (fail $ "failed to find " ++ unpack key ++ "/totalItems in " ++ show v) parseJSON $ totalItems' key + totalItems' key = case M.lookup key v of + Just (Object obj) -> M.lookup "totalItems" obj + _ -> Nothing + parseJSON v = typeMismatch "ActivityObject" v + +-- |Types of objects that can be associated with an Activity +data ActivityObjectType = Note | -- ^ Textual content + GooglePlusActivity -- ^ A Google+ Activity + deriving (Show, Eq) + +instance FromJSON ActivityObjectType where + parseJSON (String "note") = pure Note + parseJSON (String "activity") = pure GooglePlusActivity + parseJSON v = typeMismatch "ActivityObjectType" v + +-- |Media attached to an Activity +data Attachment = Attachment { attachmentContent :: Maybe Text, -- ^ Snippet of text if the Attachment is an article + attachmentDisplayName :: Maybe Text, -- ^ Title of the Attachment + attachmentEmbed :: Maybe Embed, -- ^ Embeddable link if the Attachment is a video + attachmentFullImage :: Maybe Image, -- ^ Full image if the Attachment is a photo + attachmentId :: Maybe ID, -- ^ ID of the Attachment's resource + attachmentImage :: Maybe Image, -- ^ Preview image + attachmentType :: AttachmentType, -- ^ Type of attachment + attachmentURL :: Maybe URL -- ^ Lin k to text/html attachment + } deriving (Show, Eq) + +instance FromJSON Attachment where + parseJSON (Object v) = Attachment <$> v .:? "content" + <*> v .:? "displayName" + <*> v .:? "embed" + <*> v .:? "fullImage" + <*> v .:? "id" + <*> v .:? "image" + <*> v .: "objectType" + <*> v .:? "url" + parseJSON v = typeMismatch "AttachmentType" v + +-- |Embeddable link for an attachment if it is a video +data Embed = Embed { embedType :: Text, -- ^ Type of embeddable link + embedUrl :: URL -- ^ Embeddable link + } deriving (Show, Eq) + +instance FromJSON Embed where + parseJSON (Object v) = Embed <$> v .: "type" + <*> v .: "url" + parseJSON v = typeMismatch "Embed" v + +-- |Type of Activity Attachment +data AttachmentType = Photo | + PhotoAlbum | -- ^ A type that occurs in the wild but is not mentioned in the Google+ API docs + Video | + Article -- ^ An article attachment specified by a link by the poster + deriving (Show, Eq) + +instance FromJSON AttachmentType where + parseJSON (String "photo") = pure Photo + parseJSON (String "photo-album") = pure PhotoAlbum + parseJSON (String "video") = pure Video + parseJSON (String "article") = pure Article + parseJSON v = typeMismatch "AttachmentType" v + +-- |Geolocation based on longitude and latitude +data Geocode = Geocode { latitude :: Double, + longitude :: Double } deriving (Show, Eq) + +instance FromJSON Geocode where + parseJSON (String str) = pure $ Geocode long lat + where (longT, latT) = spanSkip ' ' str + long = read . unpack $ longT + lat = read . unpack $ latT + parseJSON v = typeMismatch "Geocode" v + +-- |Describes who has access to a given Activity resource +data Access = Access { accessDescription :: Maybe Text, -- ^ Description of the access, suitable for display + accessItems :: [AccessItem] -- ^ List of access entries + } deriving (Show, Eq) + +instance FromJSON Access where + parseJSON (Object v) = Access <$> v .:? "description" + <*> v .: "items" + parseJSON v = typeMismatch "Access" v + +-- |AccessEntry that describes the type of access someone may have to an Activity +data AccessItem = AccessItem { accessItemId :: Maybe ID, -- ^ ID of the entry. Only set when this AccessItem refers to a Person or Circle + accessItemType :: AccessItemType -- ^ Type of entity which has access to the associated Activity + } deriving (Show, Eq) + +instance FromJSON AccessItem where + parseJSON (Object v) = AccessItem <$> v .:? "id" + <*> v .: "type" + parseJSON v = typeMismatch "AccessItem" v + +-- |Type of entity which may access an Activity +data AccessItemType = PersonAccess | + CircleAccess | + MyCirclesAccess | -- ^ Access granted to all members of the Actor's circles + ExtendedCirclesAccess | -- ^ Access granted to members of the Actor's circles and their circles as well + PublicAccess -- ^ Access to anyone on the internet + deriving (Show, Eq) + +instance FromJSON AccessItemType where + parseJSON (String "person") = pure PersonAccess + parseJSON (String "circle") = pure CircleAccess + parseJSON (String "myCircles") = pure MyCirclesAccess + parseJSON (String "extendedCircles") = pure ExtendedCirclesAccess + parseJSON (String "public") = pure PublicAccess + parseJSON v = typeMismatch "AccessItemType" v + +-- |Service provider who originally published an Activity +data Provider = Provider { providerTitle :: Text } deriving (Show, Eq) + +instance FromJSON Provider where + parseJSON (Object v) = Provider <$> v .: "title" + parseJSON v = typeMismatch "Provider" v + +---------- Person Types + +-- |A member of Google+ +data Person = Person { personId :: ID, -- ^ Id of the Person + personDisplayName :: Text, -- ^ Name of the Person, suitable for display + personName :: Maybe PersonName, -- ^ Person's actual, full name + personNickName :: Maybe Text, -- ^ Optional nickname of the Person + personTagline :: Maybe Text, -- ^ Brief description of the Person + personBirthday :: Maybe Day, -- ^ Person's Birthday + personGender :: Maybe Gender, -- ^ Person's gender + personAboutMe :: Maybe Text, -- ^ About Me profile section + personCurrentLocation :: Maybe Text, -- ^ Current location of the Person + personRelationshipStatus :: Maybe RelationshipStatus, -- ^ Person's current relationship status + personProfileURL :: URL, -- ^ URL to the person's profile + personImage :: Image, -- ^ Profile image for the Person + personEmails :: [Email], -- ^ Email addresses that the person uses + personURLs :: [PersonURL], -- ^ External URLs on the Person's profile + personOrganizations :: [Organization], -- ^ Organizations that the Person has belonged to, past and present + personPlacesLived :: [Place], -- ^ Places in which the Person has lived + personLanguagesSpoken :: [Language], -- ^ Languages the Person speaks + personHasApp :: Maybe Bool } deriving (Show, Eq) + +instance FromJSON Person where + parseJSON (Object v) = Person <$> v .: "id" + <*> v .: "displayName" + <*> v .:? "name" + <*> v .:? "nickname" + <*> v .:? "tagline" + <*> v .:? "birthday" + <*> v .:? "gender" + <*> v .:? "aboutMe" + <*> v .:? "currentLocation" + <*> v .:? "relationshipStatus" + <*> v .: "url" + <*> v .: "image" + <*> v .:| ("emails", []) + <*> v .:| ("urls", []) + <*> v .:| ("organizations", []) + <*> v .:| ("placesLived", []) + <*> v .:| ("languagesSpoken", []) + <*> v .:? "hasApp" + parseJSON v = typeMismatch "Person" v + +instance FromJSON Day where + parseJSON (String str) = pure . read . unpack $ str + parseJSON v = typeMismatch "Day" v + +-- |Person's gender +data Gender = Male | + Female | + OtherGender + deriving (Show, Eq) + +instance FromJSON Gender where + parseJSON (String "male") = pure Male + parseJSON (String "female") = pure Female + parseJSON (String "other") = pure OtherGender + parseJSON v = typeMismatch "Gender" v + + +-- |Identifier used for finding a Person +data PersonID = PersonID Text | -- ^ ID for a specific user + Me -- ^ The authenticated user + deriving (Show, Eq) + +-- |Full, real name of a Person +data PersonName = PersonName { familyName :: Text, + formatted :: Text, -- ^ Fully formatted name of a Person including middle names, suffixes, etc. + givenName :: Text, -- ^ The given (first) name of a Person + honorificPrefix :: Text, -- ^ Prefix to a Person's name such as Dr. or Mrs. + honorificSuffix :: Text, -- ^ Suffix of a Person's name such as Jr. + middleName :: Text + } deriving (Show, Eq) + +instance FromJSON PersonName where + parseJSON (Object v) = PersonName <$> v .: "familyName" + <*> v .: "formatted" + <*> v .: "givenName" + <*> v .: "honorificPrefix" + <*> v .: "honorificSuffix" + <*> v .: "middleName" + parseJSON v = typeMismatch "PersonName" v + +-- |Image resource on Google+ +data Image = Image { imageURL :: URL, + imageType :: Maybe Text, -- ^ Media type of the link + imageWidth :: Maybe Integer, + imageHeight :: Maybe Integer + } deriving (Show, Eq) + +instance FromJSON Image where + parseJSON (Object v) = Image <$> v .: "url" + <*> v .:? "type" + <*> v .:? "width" + <*> v .:? "height" + parseJSON v = typeMismatch "Image" v + +-- |Email address belonging to the User +data Email = Email { emailPrimary :: Bool, -- ^ Whether or not the Email is the Person's primary Email + emailType :: EmailType, -- ^ Type/context of the Email address + emailAddressValue :: Text -- ^ The actual text address of the Email + } deriving (Show, Eq) + +instance FromJSON Email where + parseJSON (Object v) = Email <$> v .: "primary" + <*> v .: "type" + <*> v .: "value" + parseJSON v = typeMismatch "Email" v + +-- |Context/types of Emails that a Person can have +data EmailType = HomeEmail | + WorkEmail | + OtherEmail deriving (Show, Eq) + +instance FromJSON EmailType where + parseJSON (String "home") = pure HomeEmail + parseJSON (String "work") = pure WorkEmail + parseJSON (String "other") = pure OtherEmail + parseJSON v = typeMismatch "EmailType" v + +-- |External URLS that the Person has published +data PersonURL = PersonURL { personUrlPrimary :: Bool, -- ^ Whether or not the URL is the Person's primary URl + personUrlType :: PersonURLType, -- ^ Type of URL + personURLValue :: URL -- ^ Actual text URl for the Person + } deriving (Show, Eq) + +instance FromJSON PersonURL where + parseJSON (Object v) = PersonURL <$> v .:| ("primary", False) + <*> v .: "type" + <*> v .: "value" + parseJSON v = typeMismatch "PersonURL" v + +-- |Context/types of URLS that a Person can have +data PersonURLType = HomeURL | + WorkURL | + BlogURL | + ProfileURL | + JsonURL | -- ^ This is not a documented value, yet I've encountered it in the wild. I have no idea what it means. + OtherURL + deriving (Show, Eq) + +instance FromJSON PersonURLType where + parseJSON (String "home") = pure HomeURL + parseJSON (String "work") = pure WorkURL + parseJSON (String "blog") = pure BlogURL + parseJSON (String "profile") = pure ProfileURL + parseJSON (String "other") = pure OtherURL + parseJSON (String "json") = pure JsonURL + parseJSON v = typeMismatch "PersonURLType" v + +instance FromJSON URL where + parseJSON (String str) = maybe (fail $ "Failed to parse URL " ++ unpack str) pure parsed + where parsed = importURL . unpack $ str + parseJSON v = typeMismatch "URL" v + + +-- |Organization to which a Persion currently or previously may belong +data Organization = Organization { organizationDepartment :: Maybe Text, -- ^ Department of an Organization in which the Person resided + organizationDescription :: Maybe Text, -- ^ General description of the Organization + organizationEndDate :: Maybe Text, -- ^ Date on which the user stopped at the organization in an unspecified text format + organizationLocation :: Maybe Text, -- ^ Location of the Organization + organizationName :: Text, -- ^ Name of the Organization + organizationPrimary :: Bool, -- ^ Whether or not this Organization was the Person's primary one + organizationstartDate :: Maybe Text, -- ^ Date on which the user started at the organization in an unspecified text format + organizationTitle :: Text, -- ^ The Person's role at the Organization + organizationType :: OrganizationType -- ^ The type of Organization + } deriving (Show, Eq) + +instance FromJSON Organization where + parseJSON (Object v) = Organization <$> v .:? "department" + <*> v .:? "description" + <*> v .:? "endDate" + <*> v .:? "location" + <*> v .: "name" + <*> v .:| ("primary", False) + <*> v .:? "startDate" + <*> v .: "title" + <*> v .: "type" + parseJSON v = typeMismatch "Organization" v + +-- |The capacity in which the Perosn participated in an Organization +data OrganizationType = Work | + School + deriving (Show, Eq) + +instance FromJSON OrganizationType where + parseJSON (String "work") = pure Work -- spec says job. fail. + parseJSON (String "school") = pure School + parseJSON v = typeMismatch "OrganizationType" v + +-- |A physical location where a Person resides/resided +data Place = Place { placePrimary :: Bool, -- ^ Whether or not this is/was the Person's primary residence + placeValue :: Text -- ^ Text description of the Place + } deriving (Show, Eq) + +instance FromJSON Place where + parseJSON (Object v) = Place <$> v .: "primary" + <*> v .: "value" + parseJSON v = typeMismatch "Place" v + +type Language = Text + +-- |Relationship status of a Person +data RelationshipStatus = Single | + InARelationship | + Engaged | + Married | + ItsComplicated | + OpenRelationship | + Widowed | + InDomesticPartnership | + InCivilUnion + deriving (Show, Eq) + +instance FromJSON RelationshipStatus where + parseJSON (String "single") = pure Single + parseJSON (String "in_a_relationship") = pure InARelationship + parseJSON (String "engaged") = pure Engaged + parseJSON (String "married") = pure Married + parseJSON (String "its_complicated") = pure ItsComplicated + parseJSON (String "open_relationship") = pure OpenRelationship + parseJSON (String "widowed") = pure Widowed + parseJSON (String "in_domestic_partnership") = pure InDomesticPartnership + parseJSON (String "in_civil_union") = pure InCivilUnion + parseJSON v = typeMismatch "RelationshipStatus" v + +(.:|) :: (FromJSON a) => Object -> (Text, a) -> Parser a +obj .:| (key, d) = case M.lookup key obj of + Nothing -> pure d + Just v -> parseJSON v + +spanSkip :: Char -> Text -> (Text, Text) +spanSkip cond xs = (left, T.tail right) + where (left, right) = T.span (/= cond) xs diff --git a/googleplus.cabal b/googleplus.cabal new file mode 100644 --- /dev/null +++ b/googleplus.cabal @@ -0,0 +1,44 @@ +name: googleplus +version: 0.1.0 +synopsis: Haskell implementation of the Google+ API +description: + Will implement the Google+ REST API. Google+ is a social network made by + Google. Found out more at . + + Currently supports the API-key authentication only. OAuth should be coming + along at some point. Only features read-only API access beacuse that is all + that Google has published thus far. + +category: Web +license: BSD3 +license-file: LICENSE +author: Michael Xavier +maintainer: Michael Xavier +cabal-version: >= 1.6 +build-type: Simple +extra-source-files: README +homepage: http://github.com/michaelxavier/GooglePlus + +library + Exposed-modules: Web.GooglePlus, + Web.GooglePlus.Types, + Web.GooglePlus.Monad + Ghc-Options: -Wall + build-depends: base >= 4 && < 5, + aeson >= 0.3.1.1 && < 0.4, + bytestring >= 0.9.1.10 && < 0.10, + text >= 0.11.0.5 && < 0.12, + attoparsec >= 0.9.1.2 && < 0.10, + http-enumerator >= 0.7.0 && < 0.8, + mtl >= 2.0.1.0 && < 2.1, + rfc3339 >= 1.0.4 && < 1.1, + time >= 1.2.0.3 && < 1.5, + transformers >= 0.2.2.0 && < 0.3, + http-types >= 0.6.0 && < 0.7, + url >= 2.1.2 && < 2.3, + haskell98 >= 1.1.0.1 && < 1.2, + containers >= 0.4.0.0 && < 0.5 + +source-repository head + type: git + location: git://github.com/michaelxavier/GooglePlus.git