module Network.Google.Data.Time
( Time' (..)
, Date' (..)
, DateTime' (..)
, _Time
, _Date
, _DateTime
) where
import Control.Lens
import Data.Aeson
import Data.Aeson.Encode
import qualified Data.Aeson.Types as Aeson
import Data.Attoparsec.Text
import Data.Bits ((.&.))
import Data.Char (ord)
import Data.Data (Data, Typeable)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Builder as Build
import Data.Time
import GHC.Generics
import Servant.Common.Text
newtype Time' = Time' TimeOfDay
deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
_Time :: Iso' Time' TimeOfDay
_Time = iso (\(Time' t) -> t) Time'
newtype Date' = Date' Day
deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
_Date :: Iso' Date' Day
_Date = iso (\(Date' t) -> t) Date'
newtype DateTime' = DateTime' UTCTime
deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
_DateTime :: Iso' DateTime' UTCTime
_DateTime = iso (\(DateTime' t) -> t) DateTime'
instance FromText Time' where fromText = fmap Time' . parseText timeParser
instance FromText Date' where fromText = fmap Date' . parseText dayParser
instance FromText DateTime' where fromText = Aeson.parseMaybe parseJSON . String
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
instance ToText Time' where toText = Text.pack . show . view _Time
instance ToText Date' where toText = Text.pack . show . view _Date
instance ToText DateTime' where toText = encodeText
instance ToJSON Time' where toJSON = String . toText
instance ToJSON Date' where toJSON = String . toText
instance ToJSON DateTime' where toJSON = toJSON . view _DateTime
parseText :: Parser a -> Text -> Maybe a
parseText p = either (const Nothing) Just . parseOnly p
encodeText :: ToJSON a => a -> Text
encodeText = LText.toStrict . Build.toLazyText . encodeToTextBuilder . toJSON
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