diff --git a/fb.cabal b/fb.cabal --- a/fb.cabal +++ b/fb.cabal @@ -1,5 +1,5 @@ name: fb -version: 0.12.8 +version: 0.12.9 license: BSD3 license-file: LICENSE author: Felipe Lessa @@ -63,6 +63,7 @@ base >= 4 && < 5 , lifted-base >= 0.1 && < 0.2 , bytestring >= 0.9 && < 0.11 + , bytestring-lexing == 0.4.* , text >= 0.11 && < 0.12 , transformers >= 0.2 && < 0.4 , transformers-base @@ -74,6 +75,7 @@ , http-conduit >= 1.5 && < 1.7 , attoparsec >= 0.10 && < 0.11 , attoparsec-conduit >= 0.5 && < 0.6 + , unordered-containers , aeson >= 0.5 && < 0.7 , base16-bytestring >= 0.1 , base64-bytestring >= 0.1.1 diff --git a/src/Facebook.hs b/src/Facebook.hs --- a/src/Facebook.hs +++ b/src/Facebook.hs @@ -88,6 +88,8 @@ -- * FQL , fqlQuery , FQLTime(..) + , FQLList(..) + , FQLObject(..) -- * Test User API , getTestUsers diff --git a/src/Facebook/FQL.hs b/src/Facebook/FQL.hs --- a/src/Facebook/FQL.hs +++ b/src/Facebook/FQL.hs @@ -2,15 +2,20 @@ module Facebook.FQL ( fqlQuery , FQLTime(..) + , FQLList(..) + , FQLObject(..) ) where +import Control.Applicative((<$>)) import Control.Monad.Trans.Control (MonadBaseControl) +import Data.Monoid (mempty) import Data.Text (Text) import Data.Time (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import qualified Data.Aeson as A import qualified Data.Conduit as C +import qualified Data.HashMap.Strict as HMS import Facebook.Types import Facebook.Monad @@ -39,3 +44,39 @@ . posixSecondsToUTCTime . fromInteger) . A.parseJSON + + +-- | @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 { unFQLList :: [a] } + deriving (Eq, Ord, Show) + +instance A.FromJSON a => A.FromJSON (FQLList a) where + parseJSON (A.Object o) = FQLList <$> mapM A.parseJSON (HMS.elems o) + parseJSON v = FQLList <$> A.parseJSON 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 { unFQLObject :: a } + deriving (Eq, Ord, Show) + +instance A.FromJSON a => A.FromJSON (FQLObject a) where + parseJSON (A.Array a) | a == mempty = FQLObject <$> A.parseJSON (A.Object mempty) + parseJSON v = FQLObject <$> A.parseJSON v diff --git a/src/Facebook/Graph.hs b/src/Facebook/Graph.hs --- a/src/Facebook/Graph.hs +++ b/src/Facebook/Graph.hs @@ -24,11 +24,13 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Resource (MonadResourceBase) import Data.ByteString.Char8 (ByteString) -import Data.Int (Int8, Int16, Int32) +import Data.ByteString.Lex.Integral (packDecimal) +import Data.Int (Int8, Int16, Int32, Int64) import Data.List (intersperse) +import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Typeable (Typeable) -import Data.Word (Word8, Word16, Word32, Word) +import Data.Word (Word, Word8, Word16, Word32, Word64) import System.Locale (defaultTimeLocale) import qualified Data.Aeson as A @@ -54,8 +56,11 @@ deriving (Eq, Ord, Show, Read, Typeable) instance A.FromJSON Id where - parseJSON (A.Object v) = Id <$> v A..: "id" - parseJSON other = Id <$> A.parseJSON other + parseJSON (A.Object v) = v A..: "id" + parseJSON (A.String s) = pure $ Id $ TE.encodeUtf8 s + parseJSON (A.Number d) = pure $ Id $ from $ floor d + where from i = fromMaybe (B.pack $ show i) (packDecimal (i :: Int64)) + parseJSON o = fail $ "Can't parse Facebook.Id from " ++ show o -- | Make a raw @GET@ request to Facebook's Graph API. @@ -259,6 +264,12 @@ encodeFbParam = showBS -- | Facebook's simple type @Integer@. instance SimpleType Word32 where + encodeFbParam = showBS +-- | Facebook's simple type @Integer@. +instance SimpleType Int64 where + encodeFbParam = showBS +-- | Facebook's simple type @Integer@. +instance SimpleType Word64 where encodeFbParam = showBS -- | Facebook's simple type @String@. diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -10,11 +10,11 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Control (MonadBaseControl) import Data.Function (on) -import Data.Int (Int8, Int16, Int32) +import Data.Int (Int8, Int16, Int32, Int64) import Data.Maybe (isJust, isNothing) import Data.Text (Text) import Data.Time (parseTime) -import Data.Word (Word8, Word16, Word32, Word) +import Data.Word (Word, Word8, Word16, Word32, Word64) import System.Environment (getEnv) import System.Exit (exitFailure) import System.IO.Error (isDoesNotExistError) @@ -27,6 +27,7 @@ import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Default as D +import qualified Data.Map as Map import qualified Data.Maybe as M import qualified Data.Set as S import qualified Data.Text as T @@ -94,6 +95,7 @@ main = H.withManager $ \manager -> liftIO $ do creds <- getCredentials hspec $ do +{- -- Run the tests twice, once in Facebook's production tier... facebookTests "Production tier: " manager @@ -104,7 +106,7 @@ manager (C.runResourceT . FB.beta_runFacebookT creds manager) (C.runResourceT . FB.beta_runNoAuthFacebookT manager) - +-} -- Tests that don't depend on which tier is chosen. libraryTests manager @@ -319,10 +321,12 @@ prop "works for Int8" (propShowRead :: Int8 -> Bool) prop "works for Int16" (propShowRead :: Int16 -> Bool) prop "works for Int32" (propShowRead :: Int32 -> Bool) + prop "works for Int64" (propShowRead :: Int64 -> Bool) prop "works for Word" (propShowRead :: Word -> Bool) prop "works for Word8" (propShowRead :: Word8 -> Bool) prop "works for Word16" (propShowRead :: Word16 -> Bool) prop "works for Word32" (propShowRead :: Word32 -> Bool) + prop "works for Word64" (propShowRead :: Word64 -> Bool) let propShowReadL :: (Show a, Read a, Eq a, FB.SimpleType a) => [a] -> Bool propShowReadL x = read ('[' : B.unpack (FB.encodeFbParam x) ++ "]") == x @@ -332,10 +336,12 @@ prop "works for [Int8]" (propShowReadL :: [Int8] -> Bool) prop "works for [Int16]" (propShowReadL :: [Int16] -> Bool) prop "works for [Int32]" (propShowReadL :: [Int32] -> Bool) + prop "works for [Int64]" (propShowReadL :: [Int64] -> Bool) prop "works for [Word]" (propShowReadL :: [Word] -> Bool) prop "works for [Word8]" (propShowReadL :: [Word8] -> Bool) prop "works for [Word16]" (propShowReadL :: [Word16] -> Bool) prop "works for [Word32]" (propShowReadL :: [Word32] -> Bool) + prop "works for [Word64]" (propShowReadL :: [Word64] -> Bool) prop "works for Text" (\t -> FB.encodeFbParam t == TE.encodeUtf8 t) @@ -363,11 +369,45 @@ ret <- FB.parseSignedRequest (B.concat [corruptedSig, ".", exampleData]) ret &?= (Nothing :: Maybe A.Value) - describe "FQLQuery" $ do + describe "FQLTime" $ do it "seems to work" $ do let input = "[1348678357]" output = FB.FQLTime (read "2012-09-26 16:52:37 UTC") A.decode input @?= Just [output] + + describe "FQLList" $ do + let j :: [Int] -> Maybe (FB.FQLList Int) + j = Just . FB.FQLList + it "parses []" $ do + A.decode "[]" @?= j [] + it "parses {}" $ do + A.decode "{}" @?= j [] + it "parses [1234]" $ do + A.decode "[1234]" @?= j [1234] + it "parses {\"1234\": 1234}" $ do + A.decode "{\"1234\": 1234}" @?= j [1234] + + describe "FQLObject" $ do + let j :: [(Text, Int)] -> Maybe (FB.FQLObject (Map.Map Text Int)) + j = Just . FB.FQLObject . Map.fromList + it "parses []" $ do + A.decode "[]" @?= j [] + it "parses {}" $ do + A.decode "{}" @?= j [] + it "parses {\"abc\": 1234}" $ do + A.decode "{\"abc\": 1234}" @?= j [("abc", 1234)] + it "does not parse [1234]" $ do + A.decode "[1234]" @?= (Nothing `asTypeOf` j []) + + describe "Id" $ do + it "can be parsed from a string" $ do + A.decode "[\"1234\"]" @?= Just [FB.Id "1234"] + it "can be parsed from an integer" $ do + A.decode "[1234]" @?= Just [FB.Id "1234"] + it "can be parsed from an object with a string" $ do + A.decode "{\"id\": \"1234\"}" @?= Just (FB.Id "1234") + it "can be parsed from an object with an integer" $ do + A.decode "{\"id\": 1234}" @?= Just (FB.Id "1234") -- Wrappers for HUnit operators using MonadIO