diff --git a/Web/Twitter/Types.hs b/Web/Twitter/Types.hs --- a/Web/Twitter/Types.hs +++ b/Web/Twitter/Types.hs @@ -1,8 +1,7 @@ -{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, RecordWildCards, DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, RecordWildCards, DeriveGeneric, CPP #-} module Web.Twitter.Types - ( DateString - , UserId + ( UserId , Friends , URIString , UserName @@ -35,6 +34,7 @@ , UploadedMedia (..) , ImageSizeType (..) , checkError + , twitterTimeFormat ) where @@ -44,10 +44,17 @@ import Data.Aeson.Types (Parser) import Data.Data import Data.HashMap.Strict (HashMap, fromList, union) -import Data.Text (Text) +import Data.Text (Text, unpack, pack) import GHC.Generics +#if MIN_VERSION_time(1, 5, 0) +import Data.Time +#else +import Data.Time +import System.Locale +#endif -type DateString = String +newtype TwitterTime = TwitterTime { fromTwitterTime :: UTCTime } + type UserId = Integer type Friends = [UserId] type URIString = Text @@ -71,6 +78,22 @@ Just msg -> fail msg Nothing -> return () +twitterTimeFormat :: String +twitterTimeFormat = "%a %b %d %T %z %Y" + +instance FromJSON TwitterTime where + parseJSON = withText "TwitterTime" $ \t -> +#if MIN_VERSION_time(1, 5, 0) + case parseTimeM True defaultTimeLocale twitterTimeFormat (unpack t) of +#else + case parseTime defaultTimeLocale twitterTimeFormat (unpack t) of +#endif + Just d -> pure $ TwitterTime d + Nothing -> fail $ "Could not parse twitter time. Text was: " ++ unpack t + +instance ToJSON TwitterTime where + toJSON t = String $ pack $ formatTime defaultTimeLocale twitterTimeFormat $ fromTwitterTime t + instance FromJSON StreamingAPI where parseJSON v@(Object o) = SRetweetedStatus <$> js <|> @@ -97,7 +120,7 @@ data Status = Status { statusContributors :: Maybe [Contributor] , statusCoordinates :: Maybe Coordinates - , statusCreatedAt :: DateString + , statusCreatedAt :: UTCTime , statusCurrentUserRetweet :: Maybe UserId , statusEntities :: Maybe Entities , statusExtendedEntities :: Maybe Entities @@ -128,7 +151,7 @@ parseJSON (Object o) = checkError o >> Status <$> o .:? "contributors" <*> o .:? "coordinates" - <*> o .: "created_at" + <*> (o .: "created_at" >>= return . fromTwitterTime) <*> ((o .: "current_user_retweet" >>= (.: "id")) <|> return Nothing) <*> o .:? "entities" <*> o .:? "extended_entities" @@ -158,7 +181,7 @@ instance ToJSON Status where toJSON Status{..} = object [ "contributors" .= statusContributors , "coordinates" .= statusCoordinates - , "created_at" .= statusCreatedAt + , "created_at" .= TwitterTime statusCreatedAt , "current_user_retweet" .= object [ "id" .= statusCurrentUserRetweet , "id_str" .= show statusCurrentUserRetweet ] @@ -208,7 +231,7 @@ data SearchStatus = SearchStatus - { searchStatusCreatedAt :: DateString + { searchStatusCreatedAt :: UTCTime , searchStatusId :: StatusId , searchStatusText :: Text , searchStatusSource :: Text @@ -218,7 +241,7 @@ instance FromJSON SearchStatus where parseJSON (Object o) = checkError o >> - SearchStatus <$> o .: "created_at" + SearchStatus <$> (o .: "created_at" >>= return . fromTwitterTime) <*> o .: "id" <*> o .: "text" <*> o .: "source" @@ -227,7 +250,7 @@ parseJSON _ = mzero instance ToJSON SearchStatus where - toJSON SearchStatus{..} = object [ "created_at" .= searchStatusCreatedAt + toJSON SearchStatus{..} = object [ "created_at" .= TwitterTime searchStatusCreatedAt , "id" .= searchStatusId , "text" .= searchStatusText , "source" .= searchStatusSource @@ -275,7 +298,7 @@ data RetweetedStatus = RetweetedStatus - { rsCreatedAt :: DateString + { rsCreatedAt :: UTCTime , rsId :: StatusId , rsText :: Text , rsSource :: Text @@ -288,7 +311,7 @@ instance FromJSON RetweetedStatus where parseJSON (Object o) = checkError o >> - RetweetedStatus <$> o .: "created_at" + RetweetedStatus <$> (o .: "created_at" >>= return . fromTwitterTime) <*> o .: "id" <*> o .: "text" <*> o .: "source" @@ -300,7 +323,7 @@ parseJSON _ = mzero instance ToJSON RetweetedStatus where - toJSON RetweetedStatus{..} = object [ "created_at" .= rsCreatedAt + toJSON RetweetedStatus{..} = object [ "created_at" .= TwitterTime rsCreatedAt , "id" .= rsId , "text" .= rsText , "source" .= rsSource @@ -313,7 +336,7 @@ data DirectMessage = DirectMessage - { dmCreatedAt :: DateString + { dmCreatedAt :: UTCTime , dmSenderScreenName :: Text , dmSender :: User , dmText :: Text @@ -327,7 +350,7 @@ instance FromJSON DirectMessage where parseJSON (Object o) = checkError o >> - DirectMessage <$> o .: "created_at" + DirectMessage <$> (o .: "created_at" >>= return . fromTwitterTime) <*> o .: "sender_screen_name" <*> o .: "sender" <*> o .: "text" @@ -340,7 +363,7 @@ parseJSON _ = mzero instance ToJSON DirectMessage where - toJSON DirectMessage{..} = object [ "created_at" .= dmCreatedAt + toJSON DirectMessage{..} = object [ "created_at" .= TwitterTime dmCreatedAt , "sender_screen_name" .= dmSenderScreenName , "sender" .= dmSender , "text" .= dmText @@ -376,7 +399,7 @@ data Event = Event - { evCreatedAt :: DateString + { evCreatedAt :: UTCTime , evTargetObject :: Maybe EventTarget , evEvent :: Text , evTarget :: EventTarget @@ -385,7 +408,7 @@ instance FromJSON Event where parseJSON (Object o) = checkError o >> - Event <$> o .: "created_at" + Event <$> (o .: "created_at" >>= return . fromTwitterTime) <*> o .:? "target_object" <*> o .: "event" <*> o .: "target" @@ -393,7 +416,7 @@ parseJSON _ = mzero instance ToJSON Event where - toJSON Event{..} = object [ "created_at" .= evCreatedAt + toJSON Event{..} = object [ "created_at" .= TwitterTime evCreatedAt , "target_object" .= evTargetObject , "event" .= evEvent , "target" .= evTarget @@ -424,7 +447,7 @@ -- See . data User = User { userContributorsEnabled :: Bool - , userCreatedAt :: DateString + , userCreatedAt :: UTCTime , userDefaultProfile :: Bool , userDefaultProfileImage :: Bool , userDescription :: Maybe Text @@ -468,7 +491,7 @@ instance FromJSON User where parseJSON (Object o) = checkError o >> User <$> o .: "contributors_enabled" - <*> o .: "created_at" + <*> (o .: "created_at" >>= return . fromTwitterTime) <*> o .: "default_profile" <*> o .: "default_profile_image" <*> o .:? "description" @@ -511,7 +534,7 @@ instance ToJSON User where toJSON User{..} = object [ "contributors_enabled" .= userContributorsEnabled - , "created_at" .= userCreatedAt + , "created_at" .= TwitterTime userCreatedAt , "default_profile" .= userDefaultProfile , "default_profile_image" .= userDefaultProfileImage , "description" .= userDescription diff --git a/tests/Instances.hs b/tests/Instances.hs --- a/tests/Instances.hs +++ b/tests/Instances.hs @@ -4,13 +4,27 @@ module Instances where +import Data.String import Control.Applicative import Data.DeriveTH import qualified Data.Text as T +import Data.Time import Test.QuickCheck import Web.Twitter.Types import Data.Aeson import Data.HashMap.Strict as HashMap +import System.Locale + +instance IsString UTCTime where + fromString = readTime defaultTimeLocale twitterTimeFormat + +instance Arbitrary UTCTime where + arbitrary = + do randomDay <- choose (1, 29) :: Gen Int + randomMonth <- choose (1, 12) :: Gen Int + randomYear <- choose (2001, 2002) :: Gen Integer + randomTime <- choose (0, 86401) :: Gen Int + return $ UTCTime (fromGregorian randomYear randomMonth randomDay) (fromIntegral randomTime) instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary diff --git a/twitter-types.cabal b/twitter-types.cabal --- a/twitter-types.cabal +++ b/twitter-types.cabal @@ -1,5 +1,5 @@ name: twitter-types -version: 0.6.1 +version: 0.7.0 license: BSD3 license-file: LICENSE author: Takahiro HIMURA @@ -16,6 +16,10 @@ type: git location: git://github.com/himura/twitter-types.git +flag time15 + description: use time >= 1.5. + default: False + library ghc-options: -Wall @@ -25,6 +29,14 @@ , text , unordered-containers + if flag(time15) + build-depends: + time >= 1.5 && < 1.6 + else + build-depends: + time >= 1.2 && < 1.5 + , old-locale + if impl(ghc < 7.6) build-depends: ghc-prim @@ -49,10 +61,12 @@ , attoparsec , bytestring , text + , time , unordered-containers , filepath , directory , twitter-types + , old-locale other-modules: Fixtures Instances