twitter-types 0.6.1 → 0.7.0
raw patch · 3 files changed
+75/−24 lines, 3 filesdep +old-localedep +time
Dependencies added: old-locale, time
Files
- Web/Twitter/Types.hs +46/−23
- tests/Instances.hs +14/−0
- twitter-types.cabal +15/−1
Web/Twitter/Types.hs view
@@ -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 <https://dev.twitter.com/docs/platform-objects/users>. 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
tests/Instances.hs view
@@ -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
twitter-types.cabal view
@@ -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