module Network.Google.Data.Time
( Time'
, Date'
, DateTime'
, _Time
, _Date
, _DateTime
) where
import Control.Lens
import Data.Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Attoparsec.Text
import Data.Bifunctor (first, second)
import Data.Bits ((.&.))
import Data.Char (ord)
import Data.Data (Data, Typeable)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time
import GHC.Generics
import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))
newtype Time' = Time' { unTime :: TimeOfDay }
deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
_Time :: Iso' Time' TimeOfDay
_Time = iso unTime Time'
instance ToHttpApiData Time' where
toQueryParam = Text.pack . show . unTime
instance FromHttpApiData Time' where
parseQueryParam = second Time' . parseText timeParser
newtype Date' = Date' { unDate :: Day }
deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToHttpApiData, FromHttpApiData)
_Date :: Iso' Date' Day
_Date = iso unDate Date'
newtype DateTime' = DateTime' { unDateTime :: UTCTime }
deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToHttpApiData, FromHttpApiData)
_DateTime :: Iso' DateTime' UTCTime
_DateTime = iso unDateTime DateTime'
instance ToJSON Time' where toJSON = String . toQueryParam
instance ToJSON Date' where toJSON = String . toQueryParam
instance ToJSON DateTime' where toJSON = toJSON . unDateTime
instance FromJSON Time' where
parseJSON = fmap Time' . withText "time" (run timeParser)
instance FromJSON Date' where
parseJSON = fmap Date' . withText "date" (run dayParser)
instance FromJSON DateTime' where
parseJSON = fmap DateTime' . parseJSON
parseText :: Parser a -> Text -> Either Text a
parseText p = first Text.pack . parseOnly p
timeParser :: Parser TimeOfDay
timeParser = do
h <- twoDigits <* char ':'
m <- twoDigits <* char ':'
s <- twoDigits <&> fromIntegral
if h < 24 && m < 60 && s < 61
then pure (TimeOfDay h m s)
else fail "invalid time"
dayParser :: Parser Day
dayParser = do
y <- decimal <* char '-'
m <- twoDigits <* char '-'
d <- twoDigits
maybe (fail "invalid date") pure (fromGregorianValid y m d)
twoDigits :: Parser Int
twoDigits = do
a <- digit
b <- digit
let c2d c = ord c .&. 15
pure $! c2d a * 10 + c2d b
run :: Parser a -> Text -> Aeson.Parser a
run p t =
case parseOnly (p <* endOfInput) t of
Left err -> fail $ "could not parse date: " ++ err
Right r -> pure r