4fd7579 · gogol · git.iko.soy

git.iko.soy/gogol

on develop help sign in

Adding support for google-duration types

4fd7579Brendan Hay10 years ago

core/src/Network/Google/Data/Time.hs+34−8

compare with develop

unifiedsplit

@@ -22,17 +22,22 @@ module Network.Google.Data.Time

23import Control.Lens

24import Data.Aeson

25−import qualified Data.Aeson.Types as Aeson

25+import qualified Data.Aeson.Types as Aeson

26import Data.Attoparsec.Text

27−import Data.Bifunctor (first, second)

27+import Data.Bifunctor (first, second)

28−import Data.Bits ((.&.))

28+import Data.Bits ((.&.))

29−import Data.Char (ord)

29+import Data.Char (ord)

30−import Data.Data (Data, Typeable)

30+import Data.Data (Data, Typeable)

31+import Data.Scientific (Scientific)

32+import qualified Data.Scientific as Sci

31−import Data.Text (Text)

33+import Data.Text (Text)

32−import qualified Data.Text as Text

34+import qualified Data.Text as Text

35+import qualified Data.Text.Lazy.Builder as Build

36+import qualified Data.Text.Lazy.Builder.Scientific as Sci

33import Data.Time

37import Data.Time

34import GHC.Generics

38import GHC.Generics

35−import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))

39+import Web.HttpApiData (FromHttpApiData (..),

40+ ToHttpApiData (..))

37-- | This SHOULD be a time in the format of hh:mm:ss. It is

42-- | This SHOULD be a time in the format of hh:mm:ss. It is

38-- recommended that you use the "date-time" format instead of "time"

43-- recommended that you use the "date-time" format instead of "time"

@@ -66,10 +71,25 @@ newtype DateTime' = DateTime' { unDateTime :: UTCTime }

66_DateTime :: Iso' DateTime' UTCTime

71_DateTime :: Iso' DateTime' UTCTime

67_DateTime = iso unDateTime DateTime'

72_DateTime = iso unDateTime DateTime'

74+-- | A duration in seconds with up to nine fractional digits, terminated by 's'.

75+--

76+-- /Example/: @"3.5s"@.

77+newtype Duration = Duration { unDuration :: Scientific }

78+ deriving (Eq, Ord, Show, Generic, Data, Typeable)

79+

80+_Duration :: Iso' Duration Scientific

81+_Duration = iso unDuration Duration

82+

69instance ToJSON Time' where toJSON = String . toQueryParam

83instance ToJSON Time' where toJSON = String . toQueryParam

70instance ToJSON Date' where toJSON = String . toQueryParam

84instance ToJSON Date' where toJSON = String . toQueryParam

71instance ToJSON DateTime' where toJSON = toJSON . unDateTime

85instance ToJSON DateTime' where toJSON = toJSON . unDateTime

87+instance ToJSON Duration where

88+ toJSON = toJSON

89+ . Build.toLazyText

90+ . Sci.formatScientificBuilder Sci.Fixed (Just 9)

91+ . unDuration

92+

73instance FromJSON Time' where

93instance FromJSON Time' where

74 parseJSON = fmap Time' . withText "time" (run timeParser)

94 parseJSON = fmap Time' . withText "time" (run timeParser)

@@ -79,6 +99,9 @@ instance FromJSON Date' where

79instance FromJSON DateTime' where

99instance FromJSON DateTime' where

80 parseJSON = fmap DateTime' . parseJSON

100 parseJSON = fmap DateTime' . parseJSON

101

102+instance FromJSON Duration where

103+ parseJSON = fmap Duration . withText "duration" (run durationParser)

104+

82parseText :: Parser a -> Text -> Either Text a

105parseText :: Parser a -> Text -> Either Text a

83parseText p = first Text.pack . parseOnly p

106parseText p = first Text.pack . parseOnly p

107

@@ -100,6 +123,9 @@ dayParser = do

100 d <- twoDigits

123 d <- twoDigits

101 maybe (fail "invalid date") pure (fromGregorianValid y m d)

124 maybe (fail "invalid date") pure (fromGregorianValid y m d)

102

125

126+durationParser :: Parser Scientific

127+durationParser = Sci.fromFloatDigits <$> (double <* char 's')

128+

103-- | Parse a two-digit integer (e.g. day of month, hour).

129-- | Parse a two-digit integer (e.g. day of month, hour).

104twoDigits :: Parser Int

130twoDigits :: Parser Int

105twoDigits = do

131twoDigits = do

core/src/Network/Google/Prelude.hs+1

@@ -19,6 +19,7 @@ import Data.Int as Export (Int32, Int64)

19import Data.Maybe as Export

20import Data.Monoid as Export (mempty, (<>))

21import Data.Proxy as Export

22+import Data.Scientific as Export (Scientific)

22import Data.Text as Export (Text)

23import Data.Text as Export (Text)

23import Data.Time as Export (Day, TimeOfDay, UTCTime)

24import Data.Time as Export (Day, TimeOfDay, UTCTime)

24import Data.Word as Export (Word32, Word64, Word8)

25import Data.Word as Export (Word32, Word64, Word8)

gen/src/Gen/Syntax.hs+3

@@ -576,6 +576,7 @@ externalLit = \case

576 RsBody -> TyCon "Stream"

577 JSONValue -> TyCon "JSONValue"

578 FieldMask -> TyCon "FieldMask"

579+ Duration -> TyCon "Scientific"

579

580

580internalLit :: Lit -> Type

581internalLit :: Lit -> Type

581internalLit = \case

582internalLit = \case

@@ -597,6 +598,7 @@ internalLit = \case

597 RsBody -> TyCon "Stream"

598 RsBody -> TyCon "Stream"

598 JSONValue -> TyCon "JSONValue"

599 JSONValue -> TyCon "JSONValue"

599 FieldMask -> TyCon "FieldMask"

600 FieldMask -> TyCon "FieldMask"

601+ Duration -> TyCon "Duration"

600

602

601mapping :: TType -> Exp -> Exp

603mapping :: TType -> Exp -> Exp

602mapping t e = infixE e "." (go t)

604mapping t e = infixE e "." (go t)

@@ -617,6 +619,7 @@ iso = \case

617 TLit Time -> Just (var "_Time")

619 TLit Time -> Just (var "_Time")

618 TLit Date -> Just (var "_Date")

620 TLit Date -> Just (var "_Date")

619 TLit DateTime -> Just (var "_DateTime")

621 TLit DateTime -> Just (var "_DateTime")

622+ TLit Duration -> Just (var "_Duration")

620 TLit Float -> Just (var "_Coerce")

623 TLit Float -> Just (var "_Coerce")

621 TLit Double -> Just (var "_Coerce")

624 TLit Double -> Just (var "_Coerce")

622 TLit Byte -> Just (var "_Base64")

625 TLit Byte -> Just (var "_Base64")

gen/src/Gen/Types/Schema.hs+2

@@ -199,6 +199,7 @@ data Lit

199 | Date

200 | DateTime

201 | FieldMask

202+ | Duration

202

203

203 -- Core types.

204 -- Core types.

204 | RqBody

205 | RqBody

@@ -229,6 +230,7 @@ instance FromJSON Lit where

229

230

230 "google-datetime" -> pure DateTime

231 "google-datetime" -> pure DateTime

231 "google-fieldmask" -> pure FieldMask

232 "google-fieldmask" -> pure FieldMask

233+ "google-duration" -> pure Duration

232

234

233 _ -> fail $

235 _ -> fail $

234 "Unable to parse Literal from: " ++ Text.unpack t

236 "Unable to parse Literal from: " ++ Text.unpack t