Checkin.hs

{-# LANGUAGE DeriveDataTypeable, FlexibleContexts,
  OverloadedStrings #-}

module Facebook.Object.Checkin
  ( Checkin(..)
  , CheckinFrom(..)
  , getCheckin
  , createCheckin
  ) where
#if __GLASGOW_HASKELL__ <= 784
import Control.Applicative
#endif
import Control.Monad (mzero)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson ((.:), (.:?))
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.Typeable (Typeable)

import qualified Control.Monad.Trans.Resource as R
import qualified Data.Aeson as A

import Facebook.Types
import Facebook.Monad
import Facebook.Graph
import Facebook.Pager

-- | A Facebook check-in (see
-- <https://developers.facebook.com/docs/reference/api/checkin/>).
--
-- /NOTE:/ We still don't support all fields supported by
-- Facebook. Please fill an issue if you need access to any other
-- fields.
data Checkin = Checkin
  { checkinId :: Id
  , checkinFrom :: Maybe CheckinFrom
  , checkinPlace :: Maybe Place
  , checkinCreatedTime :: Maybe UTCTime
  , checkinTags :: Maybe (Pager Tag)
  , checkinMessage :: Maybe Text
  } deriving (Eq, Ord, Show, Read, Typeable)

instance A.FromJSON Checkin where
  parseJSON (A.Object v) =
    Checkin <$> v .: "id" <*> v .:? "from" <*> v .:? "place" <*>
    ((unFbUTCTime <$>) <$> v .:? "created_time") <*>
    v .:? "tags" <*>
    v .:? "message"
  parseJSON _ = mzero

-- | Information about the user who made the check-in.
data CheckinFrom = CheckinFrom
  { checkinFromId :: UserId
  , checkinFromName :: Text
  } deriving (Eq, Ord, Show, Read, Typeable)

instance A.FromJSON CheckinFrom where
  parseJSON (A.Object v) = CheckinFrom <$> v .: "id" <*> v .: "name"
  parseJSON _ = mzero

-- | Get a checkin from its ID.  The user access token is
-- optional, but when provided more information can be returned
-- back by Facebook.
getCheckin
  :: (R.MonadResource m, MonadBaseControl IO m)
  => Id -- ^ Checkin ID.
  -> [Argument] -- ^ Arguments to be passed to Facebook.
  -> Maybe UserAccessToken -- ^ Optional user access token.
  -> FacebookT anyAuth m Checkin
getCheckin id_ query mtoken = getObject ("/" <> idCode id_) query mtoken

-- | Creates a 'check-in' and returns its ID. Place and
-- coordinates are both required by Facebook.
createCheckin
  :: (R.MonadResource m, MonadBaseControl IO m)
  => Id -- ^ Place ID.
  -> GeoCoordinates -- ^ Coordinates.
  -> [Argument] -- ^ Other arguments of the action.
  -> UserAccessToken -- ^ Required user access token.
  -> FacebookT Auth m Id
createCheckin pid coords args usertoken = do
  let body = ("place" #= pid) : ("coordinates" #= coords) : args
  postObject "me/checkins" body usertoken