module Facebook.OpenGraph
( createAction
, Action(..)
, createCheckin
, fqlQuery
, FQLResult(..)
, (#=)
, SimpleType(..)
) where
import Control.Applicative ((<$>))
import Control.Arrow (first)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad (mzero)
import Data.ByteString.Char8 (ByteString)
import Data.Function (on)
import Data.List (intersperse)
import Data.Text (Text)
import qualified Data.Text.Lazy as TL (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Int (Int8, Int16, Int32)
import Data.Word (Word8, Word16, Word32, Word)
import Data.String (IsString(..))
import System.Locale (defaultTimeLocale)
import qualified Data.Aeson as A
import qualified Data.Aeson.Encode as AE (fromValue)
import qualified Data.ByteString.Char8 as B
import qualified Data.Conduit as C
import qualified Data.Text.Encoding as TE
import qualified Data.Time as TI
import Facebook.Types
import Facebook.Monad
import Facebook.Base
import Facebook.Graph
createAction :: (C.MonadResource m, MonadBaseControl IO m) =>
Action
-> [Argument]
-> Maybe AppAccessToken
-> UserAccessToken
-> FacebookT Auth m Id
createAction (Action action) query mapptoken usertoken = do
creds <- getCreds
let post :: (C.MonadResource m, MonadBaseControl IO m) => ByteString -> AccessToken anyKind -> FacebookT Auth m Id
post prepath = postObject (prepath <> appName creds <> ":" <> action) query
case mapptoken of
Nothing -> post "/me/" usertoken
Just apptoken -> post ("/" <> accessTokenUserId usertoken <> "/") apptoken
newtype Action = Action { unAction :: ByteString }
instance Show Action where
show = show . unAction
instance Eq Action where
(==) = (==) `on` unAction
(/=) = (/=) `on` unAction
instance Ord Action where
compare = compare `on` unAction
(<=) = (<=) `on` unAction
(<) = (<) `on` unAction
(>=) = (>=) `on` unAction
(>) = (>) `on` unAction
instance Read Action where
readsPrec = (fmap (first Action) .) . readsPrec
instance IsString Action where
fromString = Action . fromString
createCheckin :: (C.MonadResource m, MonadBaseControl IO m) =>
Id
-> (Double, Double)
-> [Argument]
-> UserAccessToken
-> FacebookT Auth m Id
createCheckin pid (lat,lon) args usertoken = do
let coords = ("coordinates", toBS $ A.object ["latitude" A..= lat, "longitude" A..= lon])
body = ("place" #= pid) : coords : args
toBS = TE.encodeUtf8 . TL.toStrict . toLazyText . AE.fromValue
postObject "me/checkins" body usertoken
fqlQuery :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>
Text
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
fqlQuery fql mtoken =
runResourceInFb $ do
let query = ["q" #= fql]
asJson =<< fbhttp =<< fbreq "/fql" mtoken query
newtype FQLResult a = FQLResult [a] deriving (Eq, Ord, Show, Read)
instance A.FromJSON a => A.FromJSON (FQLResult a) where
parseJSON (A.Object v) = FQLResult <$> (v A..: "data")
parseJSON _ = mzero
(#=) :: SimpleType a => ByteString -> a -> Argument
p #= v = (p, encodeFbParam v)
class SimpleType a where
encodeFbParam :: a -> B.ByteString
instance SimpleType Bool where
encodeFbParam b = if b then "1" else "0"
instance SimpleType TI.Day where
encodeFbParam = B.pack . TI.formatTime defaultTimeLocale "%Y-%m-%d"
instance SimpleType TI.UTCTime where
encodeFbParam = B.pack . TI.formatTime defaultTimeLocale "%Y%m%dT%H%MZ"
instance SimpleType TI.ZonedTime where
encodeFbParam = encodeFbParam . TI.zonedTimeToUTC
instance SimpleType Float where
encodeFbParam = showBS
instance SimpleType Double where
encodeFbParam = showBS
instance SimpleType Int where
encodeFbParam = showBS
instance SimpleType Word where
encodeFbParam = showBS
instance SimpleType Int8 where
encodeFbParam = showBS
instance SimpleType Word8 where
encodeFbParam = showBS
instance SimpleType Int16 where
encodeFbParam = showBS
instance SimpleType Word16 where
encodeFbParam = showBS
instance SimpleType Int32 where
encodeFbParam = showBS
instance SimpleType Word32 where
encodeFbParam = showBS
instance SimpleType Text where
encodeFbParam = TE.encodeUtf8
instance SimpleType ByteString where
encodeFbParam = id
instance SimpleType Id where
encodeFbParam = idCode
instance SimpleType a => SimpleType [a] where
encodeFbParam = B.concat . intersperse "," . map encodeFbParam
showBS :: Show a => a -> B.ByteString
showBS = B.pack . show