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

module Facebook.Graph
  ( getObject
  , postObject
  , deleteObject
  , searchObjects
  , ( #= )
  , SimpleType(..)
  , Place(..)
  , Location(..)
  , GeoCoordinates(..)
  , Tag(..)
  ) where
#if __GLASGOW_HASKELL__ <= 784
import Control.Applicative
#endif
import Control.Monad (mzero)
import Data.ByteString.Char8 (ByteString)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.List (intersperse)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.Word (Word, Word8, Word16, Word32, Word64)
#if MIN_VERSION_time(1,5,0)
import Data.Time (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
import qualified Control.Monad.Trans.Resource as R
import qualified Data.Aeson as A
#if MIN_VERSION_aeson(1,0,0)
import Data.Aeson.Text (encodeToTextBuilder)
#else
import Data.Aeson.Encode (encodeToTextBuilder)
#endif
import qualified Data.ByteString.Char8 as B
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Time as TI
import qualified Network.HTTP.Conduit as H
import qualified Network.HTTP.Types as HT

import Facebook.Auth
import Facebook.Base
import Facebook.Monad
import Facebook.Types
import Facebook.Pager

-- | Make a raw @GET@ request to Facebook's Graph API.
getObject
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)
  => Text -- ^ Path (should begin with a slash @\/@)
  -> [Argument] -- ^ Arguments to be passed to Facebook
  -> Maybe (AccessToken anyKind) -- ^ Optional access token
  -> FacebookT anyAuth m a
getObject :: Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
getObject Text
path [Argument]
query Maybe (AccessToken anyKind)
mtoken =
  FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a
forall (m :: * -> *) anyAuth a.
(MonadResource m, MonadUnliftIO m) =>
FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a
runResourceInFb (FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a)
-> FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a
forall a b. (a -> b) -> a -> b
$ Response (ConduitT () ByteString (ResourceT m) ())
-> FacebookT anyAuth (ResourceT m) 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) a)
-> FacebookT
     anyAuth
     (ResourceT m)
     (Response (ConduitT () ByteString (ResourceT m) ()))
-> FacebookT anyAuth (ResourceT m) 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
path Maybe (AccessToken anyKind)
mtoken [Argument]
query

-- | Make a raw @POST@ request to Facebook's Graph API.
postObject
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)
  => Text -- ^ Path (should begin with a slash @\/@)
  -> [Argument] -- ^ Arguments to be passed to Facebook
  -> AccessToken anyKind -- ^ Access token
  -> FacebookT Auth m a
postObject :: Text -> [Argument] -> AccessToken anyKind -> FacebookT Auth m a
postObject = ByteString
-> Text -> [Argument] -> AccessToken anyKind -> FacebookT Auth m a
forall (m :: * -> *) a anyKind.
(MonadResource m, MonadUnliftIO m, MonadThrow m, FromJSON a) =>
ByteString
-> Text -> [Argument] -> AccessToken anyKind -> FacebookT Auth m a
methodObject ByteString
HT.methodPost

-- | Make a raw @DELETE@ request to Facebook's Graph API.
deleteObject
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)
  => Text -- ^ Path (should begin with a slash @\/@)
  -> [Argument] -- ^ Arguments to be passed to Facebook
  -> AccessToken anyKind -- ^ Access token
  -> FacebookT Auth m a
deleteObject :: Text -> [Argument] -> AccessToken anyKind -> FacebookT Auth m a
deleteObject = ByteString
-> Text -> [Argument] -> AccessToken anyKind -> FacebookT Auth m a
forall (m :: * -> *) a anyKind.
(MonadResource m, MonadUnliftIO m, MonadThrow m, FromJSON a) =>
ByteString
-> Text -> [Argument] -> AccessToken anyKind -> FacebookT Auth m a
methodObject ByteString
HT.methodDelete

-- | Helper function used by 'postObject' and 'deleteObject'.
methodObject
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)
  => HT.Method
  -> Text -- ^ Path (should begin with a slash @\/@)
  -> [Argument] -- ^ Arguments to be passed to Facebook
  -> AccessToken anyKind -- ^ Access token
  -> FacebookT Auth m a
methodObject :: ByteString
-> Text -> [Argument] -> AccessToken anyKind -> FacebookT Auth m a
methodObject ByteString
method Text
path [Argument]
query AccessToken anyKind
token =
  FacebookT Auth (ResourceT m) a -> FacebookT Auth m a
forall (m :: * -> *) anyAuth a.
(MonadResource m, MonadUnliftIO m) =>
FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a
runResourceInFb (FacebookT Auth (ResourceT m) a -> FacebookT Auth m a)
-> FacebookT Auth (ResourceT m) a -> FacebookT Auth m a
forall a b. (a -> b) -> a -> b
$
  do Request
req <- Text
-> Maybe (AccessToken anyKind)
-> [Argument]
-> FacebookT Auth (ResourceT m) Request
forall (m :: * -> *) anyKind anyAuth.
MonadIO m =>
Text
-> Maybe (AccessToken anyKind)
-> [Argument]
-> FacebookT anyAuth m Request
fbreq Text
path (AccessToken anyKind -> Maybe (AccessToken anyKind)
forall a. a -> Maybe a
Just AccessToken anyKind
token) [Argument]
query
     Response (ConduitT () ByteString (ResourceT m) ())
-> FacebookT Auth (ResourceT m) 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 Auth (ResourceT m) a)
-> FacebookT
     Auth
     (ResourceT m)
     (Response (ConduitT () ByteString (ResourceT m) ()))
-> FacebookT Auth (ResourceT m) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
       Request
-> FacebookT
     Auth
     (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
req
         { method :: ByteString
H.method = ByteString
method
         }

-- | Make a raw @GET@ request to the /search endpoint of Facebook’s
-- Graph API.  Returns a raw JSON 'A.Value'.
searchObjects
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)
  => Text -- ^ A Facebook object type to search for
  -> Text -- ^ The keyword to search for
  -> [Argument] -- ^ Additional arguments to pass
  -> Maybe UserAccessToken -- ^ Optional access token
  -> FacebookT anyAuth m (Pager a)
searchObjects :: Text
-> Text
-> [Argument]
-> Maybe UserAccessToken
-> FacebookT anyAuth m (Pager a)
searchObjects Text
objectType Text
keyword [Argument]
query = Text
-> [Argument]
-> Maybe UserAccessToken
-> FacebookT anyAuth m (Pager a)
forall (m :: * -> *) a anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m, FromJSON a) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
getObject Text
"/search" [Argument]
query'
  where
    query' :: [Argument]
query' = (ByteString
"q" ByteString -> Text -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= Text
keyword) Argument -> [Argument] -> [Argument]
forall a. a -> [a] -> [a]
: (ByteString
"type" ByteString -> Text -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= Text
objectType) Argument -> [Argument] -> [Argument]
forall a. a -> [a] -> [a]
: [Argument]
query

----------------------------------------------------------------------
-- | Create an 'Argument' with a 'SimpleType'.  See the docs on
-- 'createAction' for an example.
( #= )
  :: SimpleType a
  => ByteString -> a -> Argument
ByteString
p #= :: ByteString -> a -> Argument
#= a
v = (ByteString
p, a -> ByteString
forall a. SimpleType a => a -> ByteString
encodeFbParam a
v)

-- | Class for data types that may be represented as a Facebook
-- simple type. (see
-- <https://developers.facebook.com/docs/opengraph/simpletypes/>).
class SimpleType a  where
  encodeFbParam :: a -> B.ByteString

-- | Facebook's simple type @Boolean@.
instance SimpleType Bool where
  encodeFbParam :: Bool -> ByteString
encodeFbParam Bool
b =
    if Bool
b
      then ByteString
"1"
      else ByteString
"0"

-- | Facebook's simple type @DateTime@ with only the date.
instance SimpleType TI.Day where
  encodeFbParam :: Day -> ByteString
encodeFbParam = String -> ByteString
B.pack (String -> ByteString) -> (Day -> String) -> Day -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
TI.formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%d"

-- | Facebook's simple type @DateTime@.
instance SimpleType TI.UTCTime where
  encodeFbParam :: UTCTime -> ByteString
encodeFbParam = String -> ByteString
B.pack (String -> ByteString)
-> (UTCTime -> String) -> UTCTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
TI.formatTime TimeLocale
defaultTimeLocale String
"%Y%m%dT%H%MZ"

-- | Facebook's simple type @DateTime@.
instance SimpleType TI.ZonedTime where
  encodeFbParam :: ZonedTime -> ByteString
encodeFbParam = UTCTime -> ByteString
forall a. SimpleType a => a -> ByteString
encodeFbParam (UTCTime -> ByteString)
-> (ZonedTime -> UTCTime) -> ZonedTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> UTCTime
TI.zonedTimeToUTC

-- @Enum@ doesn't make sense to support as a Haskell data type.
-- | Facebook's simple type @Float@ with less precision than supported.
instance SimpleType Float where
  encodeFbParam :: Float -> ByteString
encodeFbParam = Float -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Float@.
instance SimpleType Double where
  encodeFbParam :: Double -> ByteString
encodeFbParam = Double -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Integer@.
instance SimpleType Int where
  encodeFbParam :: Int -> ByteString
encodeFbParam = Int -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Integer@.
instance SimpleType Word where
  encodeFbParam :: Word -> ByteString
encodeFbParam = Word -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Integer@.
instance SimpleType Int8 where
  encodeFbParam :: Int8 -> ByteString
encodeFbParam = Int8 -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Integer@.
instance SimpleType Word8 where
  encodeFbParam :: Word8 -> ByteString
encodeFbParam = Word8 -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Integer@.
instance SimpleType Int16 where
  encodeFbParam :: Int16 -> ByteString
encodeFbParam = Int16 -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Integer@.
instance SimpleType Word16 where
  encodeFbParam :: Word16 -> ByteString
encodeFbParam = Word16 -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Integer@.
instance SimpleType Int32 where
  encodeFbParam :: Int32 -> ByteString
encodeFbParam = Int32 -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Integer@.
instance SimpleType Word32 where
  encodeFbParam :: Word32 -> ByteString
encodeFbParam = Word32 -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Integer@.
instance SimpleType Int64 where
  encodeFbParam :: Int64 -> ByteString
encodeFbParam = Int64 -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @Integer@.
instance SimpleType Word64 where
  encodeFbParam :: Word64 -> ByteString
encodeFbParam = Word64 -> ByteString
forall a. Show a => a -> ByteString
showBS

-- | Facebook's simple type @String@.
instance SimpleType Text where
  encodeFbParam :: Text -> ByteString
encodeFbParam = Text -> ByteString
TE.encodeUtf8

-- | Facebook's simple type @String@.
instance SimpleType ByteString where
  encodeFbParam :: ByteString -> ByteString
encodeFbParam = ByteString -> ByteString
forall a. a -> a
id

-- | An object's 'Id' code.
instance SimpleType Id where
  encodeFbParam :: Id -> ByteString
encodeFbParam = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (Id -> Text) -> Id -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Text
idCode

-- | 'Permission' is a @newtype@ of 'Text'
instance SimpleType Permission where
  encodeFbParam :: Permission -> ByteString
encodeFbParam = Text -> ByteString
forall a. SimpleType a => a -> ByteString
encodeFbParam (Text -> ByteString)
-> (Permission -> Text) -> Permission -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permission -> Text
unPermission

-- | A comma-separated list of simple types.  This definition
-- doesn't work everywhere, just for a few combinations that
-- Facebook uses (e.g. @[Int]@).  Also, encoding a list of lists
-- is the same as encoding the concatenation of all lists.  In
-- other words, this instance is here more for your convenience
-- than to make sure your code is correct.
instance SimpleType a =>
         SimpleType [a] where
  encodeFbParam :: [a] -> ByteString
encodeFbParam = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ([a] -> [ByteString]) -> [a] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
intersperse ByteString
"," ([ByteString] -> [ByteString])
-> ([a] -> [ByteString]) -> [a] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall a. SimpleType a => a -> ByteString
encodeFbParam

showBS
  :: Show a
  => a -> B.ByteString
showBS :: a -> ByteString
showBS = String -> ByteString
B.pack (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

----------------------------------------------------------------------
-- | Information about a place.  This is not a Graph Object,
-- instead it's just a field of a Object.  (Not to be confused
-- with the @Page@ object.)
data Place = Place
  { Place -> Id
placeId :: Id -- ^ @Page@ ID.
  , Place -> Maybe Text
placeName :: Maybe Text -- ^ @Page@ name.
  , Place -> Maybe Location
placeLocation :: Maybe Location
  } deriving (Place -> Place -> Bool
(Place -> Place -> Bool) -> (Place -> Place -> Bool) -> Eq Place
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Place -> Place -> Bool
$c/= :: Place -> Place -> Bool
== :: Place -> Place -> Bool
$c== :: Place -> Place -> Bool
Eq, Eq Place
Eq Place
-> (Place -> Place -> Ordering)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Place)
-> (Place -> Place -> Place)
-> Ord Place
Place -> Place -> Bool
Place -> Place -> Ordering
Place -> Place -> Place
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 :: Place -> Place -> Place
$cmin :: Place -> Place -> Place
max :: Place -> Place -> Place
$cmax :: Place -> Place -> Place
>= :: Place -> Place -> Bool
$c>= :: Place -> Place -> Bool
> :: Place -> Place -> Bool
$c> :: Place -> Place -> Bool
<= :: Place -> Place -> Bool
$c<= :: Place -> Place -> Bool
< :: Place -> Place -> Bool
$c< :: Place -> Place -> Bool
compare :: Place -> Place -> Ordering
$ccompare :: Place -> Place -> Ordering
$cp1Ord :: Eq Place
Ord, Int -> Place -> ShowS
[Place] -> ShowS
Place -> String
(Int -> Place -> ShowS)
-> (Place -> String) -> ([Place] -> ShowS) -> Show Place
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Place] -> ShowS
$cshowList :: [Place] -> ShowS
show :: Place -> String
$cshow :: Place -> String
showsPrec :: Int -> Place -> ShowS
$cshowsPrec :: Int -> Place -> ShowS
Show, ReadPrec [Place]
ReadPrec Place
Int -> ReadS Place
ReadS [Place]
(Int -> ReadS Place)
-> ReadS [Place]
-> ReadPrec Place
-> ReadPrec [Place]
-> Read Place
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Place]
$creadListPrec :: ReadPrec [Place]
readPrec :: ReadPrec Place
$creadPrec :: ReadPrec Place
readList :: ReadS [Place]
$creadList :: ReadS [Place]
readsPrec :: Int -> ReadS Place
$creadsPrec :: Int -> ReadS Place
Read, Typeable)

instance A.FromJSON Place where
  parseJSON :: Value -> Parser Place
parseJSON (A.Object Object
v) =
    Id -> Maybe Text -> Maybe Location -> Place
Place (Id -> Maybe Text -> Maybe Location -> Place)
-> Parser Id -> Parser (Maybe Text -> Maybe Location -> Place)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Id
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"id" Parser (Maybe Text -> Maybe Location -> Place)
-> Parser (Maybe Text) -> Parser (Maybe Location -> Place)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"name" Parser (Maybe Location -> Place)
-> Parser (Maybe Location) -> Parser Place
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Location)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"location"
  parseJSON Value
_ = Parser Place
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | A geographical location.
data Location = Location
  { Location -> Maybe Text
locationStreet :: Maybe Text
  , Location -> Maybe Text
locationCity :: Maybe Text
  , Location -> Maybe Text
locationState :: Maybe Text
  , Location -> Maybe Text
locationCountry :: Maybe Text
  , Location -> Maybe Text
locationZip :: Maybe Text
  , Location -> Maybe GeoCoordinates
locationCoords :: Maybe GeoCoordinates
  } deriving (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Eq Location
Eq Location
-> (Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
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 :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmax :: Location -> Location -> Location
>= :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c< :: Location -> Location -> Bool
compare :: Location -> Location -> Ordering
$ccompare :: Location -> Location -> Ordering
$cp1Ord :: Eq Location
Ord, Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show, ReadPrec [Location]
ReadPrec Location
Int -> ReadS Location
ReadS [Location]
(Int -> ReadS Location)
-> ReadS [Location]
-> ReadPrec Location
-> ReadPrec [Location]
-> Read Location
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Location]
$creadListPrec :: ReadPrec [Location]
readPrec :: ReadPrec Location
$creadPrec :: ReadPrec Location
readList :: ReadS [Location]
$creadList :: ReadS [Location]
readsPrec :: Int -> ReadS Location
$creadsPrec :: Int -> ReadS Location
Read, Typeable)

instance A.FromJSON Location where
  parseJSON :: Value -> Parser Location
parseJSON obj :: Value
obj@(A.Object Object
v) =
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe GeoCoordinates
-> Location
Location (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe GeoCoordinates
 -> Location)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe GeoCoordinates
      -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"street" Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe GeoCoordinates
   -> Location)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe GeoCoordinates -> Location)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"city" Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe GeoCoordinates -> Location)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe GeoCoordinates -> Location)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"state" Parser
  (Maybe Text -> Maybe Text -> Maybe GeoCoordinates -> Location)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe GeoCoordinates -> Location)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"country" Parser (Maybe Text -> Maybe GeoCoordinates -> Location)
-> Parser (Maybe Text) -> Parser (Maybe GeoCoordinates -> Location)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"zip" Parser (Maybe GeoCoordinates -> Location)
-> Parser (Maybe GeoCoordinates) -> Parser Location
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Value -> Parser (Maybe GeoCoordinates)
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
obj
  parseJSON Value
_ = Parser Location
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Geographical coordinates.
data GeoCoordinates = GeoCoordinates
  { GeoCoordinates -> Double
latitude :: !Double
  , GeoCoordinates -> Double
longitude :: !Double
  } deriving (GeoCoordinates -> GeoCoordinates -> Bool
(GeoCoordinates -> GeoCoordinates -> Bool)
-> (GeoCoordinates -> GeoCoordinates -> Bool) -> Eq GeoCoordinates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeoCoordinates -> GeoCoordinates -> Bool
$c/= :: GeoCoordinates -> GeoCoordinates -> Bool
== :: GeoCoordinates -> GeoCoordinates -> Bool
$c== :: GeoCoordinates -> GeoCoordinates -> Bool
Eq, Eq GeoCoordinates
Eq GeoCoordinates
-> (GeoCoordinates -> GeoCoordinates -> Ordering)
-> (GeoCoordinates -> GeoCoordinates -> Bool)
-> (GeoCoordinates -> GeoCoordinates -> Bool)
-> (GeoCoordinates -> GeoCoordinates -> Bool)
-> (GeoCoordinates -> GeoCoordinates -> Bool)
-> (GeoCoordinates -> GeoCoordinates -> GeoCoordinates)
-> (GeoCoordinates -> GeoCoordinates -> GeoCoordinates)
-> Ord GeoCoordinates
GeoCoordinates -> GeoCoordinates -> Bool
GeoCoordinates -> GeoCoordinates -> Ordering
GeoCoordinates -> GeoCoordinates -> GeoCoordinates
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 :: GeoCoordinates -> GeoCoordinates -> GeoCoordinates
$cmin :: GeoCoordinates -> GeoCoordinates -> GeoCoordinates
max :: GeoCoordinates -> GeoCoordinates -> GeoCoordinates
$cmax :: GeoCoordinates -> GeoCoordinates -> GeoCoordinates
>= :: GeoCoordinates -> GeoCoordinates -> Bool
$c>= :: GeoCoordinates -> GeoCoordinates -> Bool
> :: GeoCoordinates -> GeoCoordinates -> Bool
$c> :: GeoCoordinates -> GeoCoordinates -> Bool
<= :: GeoCoordinates -> GeoCoordinates -> Bool
$c<= :: GeoCoordinates -> GeoCoordinates -> Bool
< :: GeoCoordinates -> GeoCoordinates -> Bool
$c< :: GeoCoordinates -> GeoCoordinates -> Bool
compare :: GeoCoordinates -> GeoCoordinates -> Ordering
$ccompare :: GeoCoordinates -> GeoCoordinates -> Ordering
$cp1Ord :: Eq GeoCoordinates
Ord, Int -> GeoCoordinates -> ShowS
[GeoCoordinates] -> ShowS
GeoCoordinates -> String
(Int -> GeoCoordinates -> ShowS)
-> (GeoCoordinates -> String)
-> ([GeoCoordinates] -> ShowS)
-> Show GeoCoordinates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeoCoordinates] -> ShowS
$cshowList :: [GeoCoordinates] -> ShowS
show :: GeoCoordinates -> String
$cshow :: GeoCoordinates -> String
showsPrec :: Int -> GeoCoordinates -> ShowS
$cshowsPrec :: Int -> GeoCoordinates -> ShowS
Show, ReadPrec [GeoCoordinates]
ReadPrec GeoCoordinates
Int -> ReadS GeoCoordinates
ReadS [GeoCoordinates]
(Int -> ReadS GeoCoordinates)
-> ReadS [GeoCoordinates]
-> ReadPrec GeoCoordinates
-> ReadPrec [GeoCoordinates]
-> Read GeoCoordinates
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GeoCoordinates]
$creadListPrec :: ReadPrec [GeoCoordinates]
readPrec :: ReadPrec GeoCoordinates
$creadPrec :: ReadPrec GeoCoordinates
readList :: ReadS [GeoCoordinates]
$creadList :: ReadS [GeoCoordinates]
readsPrec :: Int -> ReadS GeoCoordinates
$creadsPrec :: Int -> ReadS GeoCoordinates
Read, Typeable)

instance A.FromJSON GeoCoordinates where
  parseJSON :: Value -> Parser GeoCoordinates
parseJSON (A.Object Object
v) =
    Double -> Double -> GeoCoordinates
GeoCoordinates (Double -> Double -> GeoCoordinates)
-> Parser Double -> Parser (Double -> GeoCoordinates)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"latitude" Parser (Double -> GeoCoordinates)
-> Parser Double -> Parser GeoCoordinates
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"longitude"
  parseJSON Value
_ = Parser GeoCoordinates
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance SimpleType GeoCoordinates where
  encodeFbParam :: GeoCoordinates -> ByteString
encodeFbParam GeoCoordinates
c =
    let obj :: Value
obj =
          [Pair] -> Value
A.object [Key
"latitude" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= GeoCoordinates -> Double
latitude GeoCoordinates
c, Key
"longitude" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= GeoCoordinates -> Double
longitude GeoCoordinates
c]
        toBS :: Value -> ByteString
toBS = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (Value -> Text) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText (Builder -> Text) -> (Value -> Builder) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Builder
forall a. ToJSON a => a -> Builder
encodeToTextBuilder
    in Value -> ByteString
toBS Value
obj

-- | A tag (i.e. \"I'll /tag/ you on my post\").
data Tag = Tag
  { Tag -> Id
tagId :: Id -- ^ Who is tagged.
  , Tag -> Text
tagName :: Text -- ^ Name of the tagged person.
  } deriving (Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, Eq Tag
Eq Tag
-> (Tag -> Tag -> Ordering)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> Ord Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
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 :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmax :: Tag -> Tag -> Tag
>= :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c< :: Tag -> Tag -> Bool
compare :: Tag -> Tag -> Ordering
$ccompare :: Tag -> Tag -> Ordering
$cp1Ord :: Eq Tag
Ord, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show, ReadPrec [Tag]
ReadPrec Tag
Int -> ReadS Tag
ReadS [Tag]
(Int -> ReadS Tag)
-> ReadS [Tag] -> ReadPrec Tag -> ReadPrec [Tag] -> Read Tag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tag]
$creadListPrec :: ReadPrec [Tag]
readPrec :: ReadPrec Tag
$creadPrec :: ReadPrec Tag
readList :: ReadS [Tag]
$creadList :: ReadS [Tag]
readsPrec :: Int -> ReadS Tag
$creadsPrec :: Int -> ReadS Tag
Read, Typeable)

instance A.FromJSON Tag where
  parseJSON :: Value -> Parser Tag
parseJSON (A.Object Object
v) = Id -> Text -> Tag
Tag (Id -> Text -> Tag) -> Parser Id -> Parser (Text -> Tag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Id
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"id" Parser (Text -> Tag) -> Parser Text -> Parser Tag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"name"
  parseJSON Value
_ = Parser Tag
forall (m :: * -> *) a. MonadPlus m => m a
mzero