{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Facebook.FQL
  ( fqlQuery
  , FQLTime(..)
  , FQLList(..)
  , FQLObject(..)
  ) where

import Control.Applicative ((<$>))
import Data.Monoid (mempty)
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)

import qualified Control.Monad.Trans.Resource as R
import qualified Data.Aeson as A
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as Keys
#else
import qualified Data.HashMap.Strict as Keys
#endif


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

-- | Query the Facebook Graph using FQL.
fqlQuery
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)
  => Text -- ^ FQL Query
  -> Maybe (AccessToken anyKind) -- ^ Optional access token
  -> FacebookT anyAuth m (Pager a)
fqlQuery :: Text
-> Maybe (AccessToken anyKind) -> FacebookT anyAuth m (Pager a)
fqlQuery Text
fql Maybe (AccessToken anyKind)
mtoken =
  FacebookT anyAuth (ResourceT m) (Pager a)
-> FacebookT anyAuth m (Pager a)
forall (m :: * -> *) anyAuth a.
(MonadResource m, MonadUnliftIO m) =>
FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a
runResourceInFb (FacebookT anyAuth (ResourceT m) (Pager a)
 -> FacebookT anyAuth m (Pager a))
-> FacebookT anyAuth (ResourceT m) (Pager a)
-> FacebookT anyAuth m (Pager a)
forall a b. (a -> b) -> a -> b
$
  do let query :: [Argument]
query = [ByteString
"q" ByteString -> Text -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= Text
fql]
     Response (ConduitT () ByteString (ResourceT m) ())
-> FacebookT anyAuth (ResourceT m) (Pager a)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(MonadIO m, MonadTrans t, MonadThrow m, FromJSON a) =>
Response (ConduitT () ByteString m ()) -> t m a
asJson (Response (ConduitT () ByteString (ResourceT m) ())
 -> FacebookT anyAuth (ResourceT m) (Pager a))
-> FacebookT
     anyAuth
     (ResourceT m)
     (Response (ConduitT () ByteString (ResourceT m) ()))
-> FacebookT anyAuth (ResourceT m) (Pager a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Request
-> FacebookT
     anyAuth
     (ResourceT m)
     (Response (ConduitT () ByteString (ResourceT m) ()))
forall (m :: * -> *) anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
Request
-> FacebookT anyAuth m (Response (ConduitT () ByteString m ()))
fbhttp (Request
 -> FacebookT
      anyAuth
      (ResourceT m)
      (Response (ConduitT () ByteString (ResourceT m) ())))
-> FacebookT anyAuth (ResourceT m) Request
-> FacebookT
     anyAuth
     (ResourceT m)
     (Response (ConduitT () ByteString (ResourceT m) ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text
-> Maybe (AccessToken anyKind)
-> [Argument]
-> FacebookT anyAuth (ResourceT m) Request
forall (m :: * -> *) anyKind anyAuth.
MonadIO m =>
Text
-> Maybe (AccessToken anyKind)
-> [Argument]
-> FacebookT anyAuth m Request
fbreq Text
"/fql" Maybe (AccessToken anyKind)
mtoken [Argument]
query

-- | @newtype@ wrapper around 'UTCTime' that is able to parse
-- FQL's time representation as seconds since the Unix epoch.
newtype FQLTime = FQLTime
  { FQLTime -> UTCTime
unFQLTime :: UTCTime
  } deriving (FQLTime -> FQLTime -> Bool
(FQLTime -> FQLTime -> Bool)
-> (FQLTime -> FQLTime -> Bool) -> Eq FQLTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FQLTime -> FQLTime -> Bool
$c/= :: FQLTime -> FQLTime -> Bool
== :: FQLTime -> FQLTime -> Bool
$c== :: FQLTime -> FQLTime -> Bool
Eq, Eq FQLTime
Eq FQLTime
-> (FQLTime -> FQLTime -> Ordering)
-> (FQLTime -> FQLTime -> Bool)
-> (FQLTime -> FQLTime -> Bool)
-> (FQLTime -> FQLTime -> Bool)
-> (FQLTime -> FQLTime -> Bool)
-> (FQLTime -> FQLTime -> FQLTime)
-> (FQLTime -> FQLTime -> FQLTime)
-> Ord FQLTime
FQLTime -> FQLTime -> Bool
FQLTime -> FQLTime -> Ordering
FQLTime -> FQLTime -> FQLTime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FQLTime -> FQLTime -> FQLTime
$cmin :: FQLTime -> FQLTime -> FQLTime
max :: FQLTime -> FQLTime -> FQLTime
$cmax :: FQLTime -> FQLTime -> FQLTime
>= :: FQLTime -> FQLTime -> Bool
$c>= :: FQLTime -> FQLTime -> Bool
> :: FQLTime -> FQLTime -> Bool
$c> :: FQLTime -> FQLTime -> Bool
<= :: FQLTime -> FQLTime -> Bool
$c<= :: FQLTime -> FQLTime -> Bool
< :: FQLTime -> FQLTime -> Bool
$c< :: FQLTime -> FQLTime -> Bool
compare :: FQLTime -> FQLTime -> Ordering
$ccompare :: FQLTime -> FQLTime -> Ordering
$cp1Ord :: Eq FQLTime
Ord, Int -> FQLTime -> ShowS
[FQLTime] -> ShowS
FQLTime -> String
(Int -> FQLTime -> ShowS)
-> (FQLTime -> String) -> ([FQLTime] -> ShowS) -> Show FQLTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FQLTime] -> ShowS
$cshowList :: [FQLTime] -> ShowS
show :: FQLTime -> String
$cshow :: FQLTime -> String
showsPrec :: Int -> FQLTime -> ShowS
$cshowsPrec :: Int -> FQLTime -> ShowS
Show)

instance A.FromJSON FQLTime where
  parseJSON :: Value -> Parser FQLTime
parseJSON = (Integer -> FQLTime) -> Parser Integer -> Parser FQLTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UTCTime -> FQLTime
FQLTime (UTCTime -> FQLTime) -> (Integer -> UTCTime) -> Integer -> FQLTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Integer -> POSIXTime) -> Integer -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger) (Parser Integer -> Parser FQLTime)
-> (Value -> Parser Integer) -> Value -> Parser FQLTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
A.parseJSON

{-# DEPRECATED
FQLTime "Deprecated since fb 0.14.7, please use FbUTCTime instead."
 #-}

-- | @newtype@ wrapper around lists that works around FQL's
-- strange lists.
--
-- For example, if you fetch the @tagged_uids@ field from
-- @location_post@, you'll find that Facebook's FQL represents an
-- empty list of tagged UIDs as plain JSON array (@[]@).
-- However, it represents a singleton list as an object
-- @{\"1234\": 1234}@ instead of the much more correct @[1234]@.
--
-- On the other hand, not all FQL arrays are represented in this
-- bogus manner.  Also, some so-called arrays by FQL's
-- documentation are actually objects, see 'FQLObject'.
newtype FQLList a = FQLList
  { FQLList a -> [a]
unFQLList :: [a]
  } deriving (FQLList a -> FQLList a -> Bool
(FQLList a -> FQLList a -> Bool)
-> (FQLList a -> FQLList a -> Bool) -> Eq (FQLList a)
forall a. Eq a => FQLList a -> FQLList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FQLList a -> FQLList a -> Bool
$c/= :: forall a. Eq a => FQLList a -> FQLList a -> Bool
== :: FQLList a -> FQLList a -> Bool
$c== :: forall a. Eq a => FQLList a -> FQLList a -> Bool
Eq, Eq (FQLList a)
Eq (FQLList a)
-> (FQLList a -> FQLList a -> Ordering)
-> (FQLList a -> FQLList a -> Bool)
-> (FQLList a -> FQLList a -> Bool)
-> (FQLList a -> FQLList a -> Bool)
-> (FQLList a -> FQLList a -> Bool)
-> (FQLList a -> FQLList a -> FQLList a)
-> (FQLList a -> FQLList a -> FQLList a)
-> Ord (FQLList a)
FQLList a -> FQLList a -> Bool
FQLList a -> FQLList a -> Ordering
FQLList a -> FQLList a -> FQLList a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (FQLList a)
forall a. Ord a => FQLList a -> FQLList a -> Bool
forall a. Ord a => FQLList a -> FQLList a -> Ordering
forall a. Ord a => FQLList a -> FQLList a -> FQLList a
min :: FQLList a -> FQLList a -> FQLList a
$cmin :: forall a. Ord a => FQLList a -> FQLList a -> FQLList a
max :: FQLList a -> FQLList a -> FQLList a
$cmax :: forall a. Ord a => FQLList a -> FQLList a -> FQLList a
>= :: FQLList a -> FQLList a -> Bool
$c>= :: forall a. Ord a => FQLList a -> FQLList a -> Bool
> :: FQLList a -> FQLList a -> Bool
$c> :: forall a. Ord a => FQLList a -> FQLList a -> Bool
<= :: FQLList a -> FQLList a -> Bool
$c<= :: forall a. Ord a => FQLList a -> FQLList a -> Bool
< :: FQLList a -> FQLList a -> Bool
$c< :: forall a. Ord a => FQLList a -> FQLList a -> Bool
compare :: FQLList a -> FQLList a -> Ordering
$ccompare :: forall a. Ord a => FQLList a -> FQLList a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (FQLList a)
Ord, Int -> FQLList a -> ShowS
[FQLList a] -> ShowS
FQLList a -> String
(Int -> FQLList a -> ShowS)
-> (FQLList a -> String)
-> ([FQLList a] -> ShowS)
-> Show (FQLList a)
forall a. Show a => Int -> FQLList a -> ShowS
forall a. Show a => [FQLList a] -> ShowS
forall a. Show a => FQLList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FQLList a] -> ShowS
$cshowList :: forall a. Show a => [FQLList a] -> ShowS
show :: FQLList a -> String
$cshow :: forall a. Show a => FQLList a -> String
showsPrec :: Int -> FQLList a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FQLList a -> ShowS
Show)

instance A.FromJSON a =>
         A.FromJSON (FQLList a) where
  parseJSON :: Value -> Parser (FQLList a)
parseJSON (A.Object Object
o) = [a] -> FQLList a
forall a. [a] -> FQLList a
FQLList ([a] -> FQLList a) -> Parser [a] -> Parser (FQLList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser a) -> [Value] -> Parser [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser a
forall a. FromJSON a => Value -> Parser a
A.parseJSON (Object -> [Value]
forall v. KeyMap v -> [v]
Keys.elems Object
o)
  parseJSON Value
v = [a] -> FQLList a
forall a. [a] -> FQLList a
FQLList ([a] -> FQLList a) -> Parser [a] -> Parser (FQLList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v

-- | @newtype@ wrapper around any object that works around FQL's
-- strange objects.
--
-- For example, if you fetch the @app_data@ field from @stream@,
-- you'll find that empty objects are actually represented as
-- empty lists @[]@ instead of a proper empty object @{}@.  Also
-- note that FQL's documentation says that @app_data@ is an
-- array, which it clear is not.  See also 'FQLList'.
newtype FQLObject a = FQLObject
  { FQLObject a -> a
unFQLObject :: a
  } deriving (FQLObject a -> FQLObject a -> Bool
(FQLObject a -> FQLObject a -> Bool)
-> (FQLObject a -> FQLObject a -> Bool) -> Eq (FQLObject a)
forall a. Eq a => FQLObject a -> FQLObject a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FQLObject a -> FQLObject a -> Bool
$c/= :: forall a. Eq a => FQLObject a -> FQLObject a -> Bool
== :: FQLObject a -> FQLObject a -> Bool
$c== :: forall a. Eq a => FQLObject a -> FQLObject a -> Bool
Eq, Eq (FQLObject a)
Eq (FQLObject a)
-> (FQLObject a -> FQLObject a -> Ordering)
-> (FQLObject a -> FQLObject a -> Bool)
-> (FQLObject a -> FQLObject a -> Bool)
-> (FQLObject a -> FQLObject a -> Bool)
-> (FQLObject a -> FQLObject a -> Bool)
-> (FQLObject a -> FQLObject a -> FQLObject a)
-> (FQLObject a -> FQLObject a -> FQLObject a)
-> Ord (FQLObject a)
FQLObject a -> FQLObject a -> Bool
FQLObject a -> FQLObject a -> Ordering
FQLObject a -> FQLObject a -> FQLObject a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (FQLObject a)
forall a. Ord a => FQLObject a -> FQLObject a -> Bool
forall a. Ord a => FQLObject a -> FQLObject a -> Ordering
forall a. Ord a => FQLObject a -> FQLObject a -> FQLObject a
min :: FQLObject a -> FQLObject a -> FQLObject a
$cmin :: forall a. Ord a => FQLObject a -> FQLObject a -> FQLObject a
max :: FQLObject a -> FQLObject a -> FQLObject a
$cmax :: forall a. Ord a => FQLObject a -> FQLObject a -> FQLObject a
>= :: FQLObject a -> FQLObject a -> Bool
$c>= :: forall a. Ord a => FQLObject a -> FQLObject a -> Bool
> :: FQLObject a -> FQLObject a -> Bool
$c> :: forall a. Ord a => FQLObject a -> FQLObject a -> Bool
<= :: FQLObject a -> FQLObject a -> Bool
$c<= :: forall a. Ord a => FQLObject a -> FQLObject a -> Bool
< :: FQLObject a -> FQLObject a -> Bool
$c< :: forall a. Ord a => FQLObject a -> FQLObject a -> Bool
compare :: FQLObject a -> FQLObject a -> Ordering
$ccompare :: forall a. Ord a => FQLObject a -> FQLObject a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (FQLObject a)
Ord, Int -> FQLObject a -> ShowS
[FQLObject a] -> ShowS
FQLObject a -> String
(Int -> FQLObject a -> ShowS)
-> (FQLObject a -> String)
-> ([FQLObject a] -> ShowS)
-> Show (FQLObject a)
forall a. Show a => Int -> FQLObject a -> ShowS
forall a. Show a => [FQLObject a] -> ShowS
forall a. Show a => FQLObject a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FQLObject a] -> ShowS
$cshowList :: forall a. Show a => [FQLObject a] -> ShowS
show :: FQLObject a -> String
$cshow :: forall a. Show a => FQLObject a -> String
showsPrec :: Int -> FQLObject a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FQLObject a -> ShowS
Show)

instance A.FromJSON a =>
         A.FromJSON (FQLObject a) where
  parseJSON :: Value -> Parser (FQLObject a)
parseJSON (A.Array Array
a)
    | Array
a Array -> Array -> Bool
forall a. Eq a => a -> a -> Bool
== Array
forall a. Monoid a => a
mempty = a -> FQLObject a
forall a. a -> FQLObject a
FQLObject (a -> FQLObject a) -> Parser a -> Parser (FQLObject a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
A.parseJSON (Object -> Value
A.Object Object
forall a. Monoid a => a
mempty)
  parseJSON Value
v = a -> FQLObject a
forall a. a -> FQLObject a
FQLObject (a -> FQLObject a) -> Parser a -> Parser (FQLObject a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v