git.iko.soy/gogol
on develop help sign in
gogol/core/src/Network/Google/Data/Time.hs
152 lines 5.4 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6-- |
7-- Module : Network.Google.Data.Time
8-- Copyright : (c) 2015-2016 Brendan Hay <brendan.g.hay@gmail.com>
9-- License : Mozilla Public License, v. 2.0.
10-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
11-- Stability : provisional
12-- Portability : non-portable (GHC extensions)
13--
14module Network.Google.Data.Time
15 ( Time'
16 , Date'
17 , DateTime' (..)
18 , GDuration
20 , _Time
21 , _Date
22 , _DateTime
23 , _GDuration
24 ) where
26import Data.Monoid ((<>))
27import Control.Lens
28import Data.Aeson
29import qualified Data.Aeson.Types as Aeson
30import Data.Attoparsec.Text
31import Data.Bifunctor (first, second)
32import Data.Bits ((.&.))
33import Data.Char (ord)
34import Data.Data (Data, Typeable)
35import Data.Scientific (Scientific)
36import qualified Data.Scientific as Sci
37import Data.Text (Text)
38import qualified Data.Text as Text
39import qualified Data.Text.Lazy as LText
40import qualified Data.Text.Lazy.Builder as Build
41import qualified Data.Text.Lazy.Builder.Scientific as Sci
42import Data.Time
43import GHC.Generics
44import Web.HttpApiData (FromHttpApiData (..),
45 ToHttpApiData (..))
47-- | This SHOULD be a time in the format of hh:mm:ss. It is
48-- recommended that you use the "date-time" format instead of "time"
49-- unless you need to transfer only the time part.
50newtype Time' = Time' { unTime :: TimeOfDay }
51 deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
53_Time :: Iso' Time' TimeOfDay
54_Time = iso unTime Time'
56instance ToHttpApiData Time' where
57 toQueryParam = Text.pack . show . unTime
59instance FromHttpApiData Time' where
60 parseQueryParam = second Time' . parseText timeParser
62-- | This SHOULD be a date in the format of YYYY-MM-DD. It is
63-- recommended that you use the "date-time" format instead of "date"
64-- unless you need to transfer only the date part.
65newtype Date' = Date' { unDate :: Day }
66 deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToHttpApiData, FromHttpApiData)
68_Date :: Iso' Date' Day
69_Date = iso unDate Date'
71-- | This SHOULD be a date in ISO 8601 format of YYYY-MM-
72-- DDThh:mm:ssZ in UTC time. This is the recommended form of date/timestamp.
73newtype DateTime' = DateTime' { unDateTime :: UTCTime }
74 deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToHttpApiData, FromHttpApiData)
76_DateTime :: Iso' DateTime' UTCTime
77_DateTime = iso unDateTime DateTime'
79-- | A duration in seconds with up to nine fractional digits, terminated by 's'.
80--
81-- /Example/: @"3.5s"@.
82newtype GDuration = GDuration { unGDuration :: Scientific }
83 deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
85_GDuration :: Iso' GDuration Scientific
86_GDuration = iso unGDuration GDuration
88instance ToHttpApiData GDuration where
89 toQueryParam =
90 LText.toStrict
91 . (\seconds -> Build.toLazyText seconds <> "s")
92 . Sci.formatScientificBuilder Sci.Fixed (Just 9)
93 . unGDuration
95instance FromHttpApiData GDuration where
96 parseQueryParam = second GDuration . parseText durationParser
98instance ToJSON Time' where toJSON = String . toQueryParam
99instance ToJSON Date' where toJSON = String . toQueryParam
100instance ToJSON DateTime' where toJSON = toJSON . unDateTime
101instance ToJSON GDuration where toJSON = String . toQueryParam
103instance FromJSON Time' where
104 parseJSON = fmap Time' . withText "time" (run timeParser)
106instance FromJSON Date' where
107 parseJSON = fmap Date' . withText "date" (run dayParser)
109instance FromJSON DateTime' where
110 parseJSON = fmap DateTime' . parseJSON
112instance FromJSON GDuration where
113 parseJSON = fmap GDuration . withText "duration" (run durationParser)
115parseText :: Parser a -> Text -> Either Text a
116parseText p = first Text.pack . parseOnly p
118-- | Parse a time of the form @HH:MM:SS@.
119timeParser :: Parser TimeOfDay
120timeParser = do
121 h <- twoDigits <* char ':'
122 m <- twoDigits <* char ':'
123 s <- twoDigits <&> fromIntegral
124 if h < 24 && m < 60 && s < 61
125 then pure (TimeOfDay h m s)
126 else fail "invalid time"
128-- | Parse a date of the form @YYYY-MM-DD@.
129dayParser :: Parser Day
130dayParser = do
131 y <- decimal <* char '-'
132 m <- twoDigits <* char '-'
133 d <- twoDigits
134 maybe (fail "invalid date") pure (fromGregorianValid y m d)
136durationParser :: Parser Scientific
137durationParser = Sci.fromFloatDigits <$> (double <* char 's')
139-- | Parse a two-digit integer (e.g. day of month, hour).
140twoDigits :: Parser Int
141twoDigits = do
142 a <- digit
143 b <- digit
144 let c2d c = ord c .&. 15
145 pure $! c2d a * 10 + c2d b
147-- | Run an attoparsec parser as an aeson parser.
148run :: Parser a -> Text -> Aeson.Parser a
149run p t =
150 case parseOnly (p <* endOfInput) t of
151 Left err -> fail $ "could not parse date: " ++ err
152 Right r -> pure r