{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- | This module has been initialized using
-- https://github.com/protocolbuffers/protobuf/blob/master/src/google/protobuf/timestamp.proto
--
-- The ToJSONPB and FromJSONPB instances have been modified to
-- be compatible with the json rfc3339 encoding
module Google.Protobuf.Timestamp where

import Control.Applicative ((<$>), (<*>), (<|>))
import qualified Control.Applicative as Hs
import qualified Control.DeepSeq as Hs
import qualified Control.Monad as Hs
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString as Hs
import qualified Data.Coerce as Hs
import qualified Data.Int as Hs (Int16, Int32, Int64)
import qualified Data.List.NonEmpty as Hs (NonEmpty (..))
import qualified Data.Map as Hs (Map, mapKeysMonotonic)
import qualified Data.Proxy as Proxy
import qualified Data.String as Hs (fromString)
import qualified Data.Text.Lazy as Hs (Text)
import qualified Data.Text.Lazy as Text
import qualified Data.Time.Clock as Time
import qualified Data.Time.Clock.System as Time
import qualified Data.Time.Format as Time
import qualified Data.Vector as Hs (Vector)
import qualified Data.Word as Hs (Word16, Word32, Word64)
import qualified GHC.Enum as Hs
import qualified GHC.Generics as Hs
import qualified Proto3.Suite.Class as HsProtobuf
import qualified Proto3.Suite.DotProto as HsProtobuf
import Proto3.Suite.JSONPB ((.:), (.=))
import qualified Proto3.Suite.JSONPB as HsJSONPB
import qualified Proto3.Suite.Types as HsProtobuf
import qualified Proto3.Wire as HsProtobuf
import qualified Unsafe.Coerce as Hs
import qualified Prelude as Hs

data Timestamp = Timestamp
  { Timestamp -> Int64
timestampSeconds :: Hs.Int64,
    Timestamp -> Int32
timestampNanos :: Hs.Int32
  }
  deriving (Int -> Timestamp -> ShowS
[Timestamp] -> ShowS
Timestamp -> String
(Int -> Timestamp -> ShowS)
-> (Timestamp -> String)
-> ([Timestamp] -> ShowS)
-> Show Timestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timestamp] -> ShowS
$cshowList :: [Timestamp] -> ShowS
show :: Timestamp -> String
$cshow :: Timestamp -> String
showsPrec :: Int -> Timestamp -> ShowS
$cshowsPrec :: Int -> Timestamp -> ShowS
Hs.Show, Timestamp -> Timestamp -> Bool
(Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool) -> Eq Timestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timestamp -> Timestamp -> Bool
$c/= :: Timestamp -> Timestamp -> Bool
== :: Timestamp -> Timestamp -> Bool
$c== :: Timestamp -> Timestamp -> Bool
Hs.Eq, Eq Timestamp
Eq Timestamp
-> (Timestamp -> Timestamp -> Ordering)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Timestamp)
-> (Timestamp -> Timestamp -> Timestamp)
-> Ord Timestamp
Timestamp -> Timestamp -> Bool
Timestamp -> Timestamp -> Ordering
Timestamp -> Timestamp -> Timestamp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Timestamp -> Timestamp -> Timestamp
$cmin :: Timestamp -> Timestamp -> Timestamp
max :: Timestamp -> Timestamp -> Timestamp
$cmax :: Timestamp -> Timestamp -> Timestamp
>= :: Timestamp -> Timestamp -> Bool
$c>= :: Timestamp -> Timestamp -> Bool
> :: Timestamp -> Timestamp -> Bool
$c> :: Timestamp -> Timestamp -> Bool
<= :: Timestamp -> Timestamp -> Bool
$c<= :: Timestamp -> Timestamp -> Bool
< :: Timestamp -> Timestamp -> Bool
$c< :: Timestamp -> Timestamp -> Bool
compare :: Timestamp -> Timestamp -> Ordering
$ccompare :: Timestamp -> Timestamp -> Ordering
$cp1Ord :: Eq Timestamp
Hs.Ord, (forall x. Timestamp -> Rep Timestamp x)
-> (forall x. Rep Timestamp x -> Timestamp) -> Generic Timestamp
forall x. Rep Timestamp x -> Timestamp
forall x. Timestamp -> Rep Timestamp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Timestamp x -> Timestamp
$cfrom :: forall x. Timestamp -> Rep Timestamp x
Hs.Generic, Timestamp -> ()
(Timestamp -> ()) -> NFData Timestamp
forall a. (a -> ()) -> NFData a
rnf :: Timestamp -> ()
$crnf :: Timestamp -> ()
Hs.NFData)

instance HsProtobuf.Named Timestamp where
  nameOf :: Proxy# Timestamp -> string
nameOf Proxy# Timestamp
_ = String -> string
forall a. IsString a => String -> a
Hs.fromString String
"Timestamp"

instance HsProtobuf.HasDefault Timestamp

instance HsProtobuf.Message Timestamp where
  encodeMessage :: FieldNumber -> Timestamp -> MessageBuilder
encodeMessage
    FieldNumber
_
    Timestamp
      { timestampSeconds :: Timestamp -> Int64
timestampSeconds = Int64
timestampSeconds,
        timestampNanos :: Timestamp -> Int32
timestampNanos = Int32
timestampNanos
      } =
      [MessageBuilder] -> MessageBuilder
forall a. Monoid a => [a] -> a
Hs.mconcat
        [ FieldNumber -> Int64 -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
HsProtobuf.encodeMessageField
            (Word64 -> FieldNumber
HsProtobuf.FieldNumber Word64
1)
            Int64
timestampSeconds,
          FieldNumber -> Int32 -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
HsProtobuf.encodeMessageField
            (Word64 -> FieldNumber
HsProtobuf.FieldNumber Word64
2)
            Int32
timestampNanos
        ]

  decodeMessage :: FieldNumber -> Parser RawMessage Timestamp
decodeMessage FieldNumber
_ =
    Int64 -> Int32 -> Timestamp
Timestamp
      (Int64 -> Int32 -> Timestamp)
-> Parser RawMessage Int64
-> Parser RawMessage (Int32 -> Timestamp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField Int64 -> FieldNumber -> Parser RawMessage Int64
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
HsProtobuf.at
        Parser RawField Int64
forall a. MessageField a => Parser RawField a
HsProtobuf.decodeMessageField
        (Word64 -> FieldNumber
HsProtobuf.FieldNumber Word64
1)
      Parser RawMessage (Int32 -> Timestamp)
-> Parser RawMessage Int32 -> Parser RawMessage Timestamp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField Int32 -> FieldNumber -> Parser RawMessage Int32
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
HsProtobuf.at
        Parser RawField Int32
forall a. MessageField a => Parser RawField a
HsProtobuf.decodeMessageField
        (Word64 -> FieldNumber
HsProtobuf.FieldNumber Word64
2)

  dotProto :: Proxy# Timestamp -> [DotProtoField]
dotProto Proxy# Timestamp
_ =
    [ FieldNumber
-> DotProtoType
-> DotProtoIdentifier
-> [DotProtoOption]
-> String
-> DotProtoField
HsProtobuf.DotProtoField
        (Word64 -> FieldNumber
HsProtobuf.FieldNumber Word64
1)
        (DotProtoPrimType -> DotProtoType
HsProtobuf.Prim DotProtoPrimType
HsProtobuf.Int64)
        (String -> DotProtoIdentifier
HsProtobuf.Single String
"seconds")
        []
        String
"",
      FieldNumber
-> DotProtoType
-> DotProtoIdentifier
-> [DotProtoOption]
-> String
-> DotProtoField
HsProtobuf.DotProtoField
        (Word64 -> FieldNumber
HsProtobuf.FieldNumber Word64
2)
        (DotProtoPrimType -> DotProtoType
HsProtobuf.Prim DotProtoPrimType
HsProtobuf.Int32)
        (String -> DotProtoIdentifier
HsProtobuf.Single String
"nanos")
        []
        String
""
    ]

rfc3339Format :: Hs.String
rfc3339Format :: String
rfc3339Format = String
"%FT%TZ"

fromUTCTime :: Time.UTCTime -> Timestamp
fromUTCTime :: UTCTime -> Timestamp
fromUTCTime UTCTime
utc = Int64 -> Int32 -> Timestamp
Timestamp Int64
sec (Integer -> Int32
forall a. Num a => Integer -> a
Hs.fromInteger (Word32 -> Integer
forall a. Integral a => a -> Integer
Hs.toInteger Word32
nano))
  where
    Time.MkSystemTime Int64
sec Word32
nano = UTCTime -> SystemTime
Time.utcToSystemTime UTCTime
utc

toUTCTime :: Timestamp -> Time.UTCTime
toUTCTime :: Timestamp -> UTCTime
toUTCTime (Timestamp Int64
sec Int32
nano) = SystemTime -> UTCTime
Time.systemToUTCTime SystemTime
systemTime
  where
    systemTime :: SystemTime
systemTime = Int64 -> Word32 -> SystemTime
Time.MkSystemTime Int64
sec (Integer -> Word32
forall a. Num a => Integer -> a
Hs.fromInteger (Int32 -> Integer
forall a. Integral a => a -> Integer
Hs.toInteger Int32
nano))

fromRFC3339 :: Hs.Text -> Hs.Maybe Timestamp
fromRFC3339 :: Text -> Maybe Timestamp
fromRFC3339 Text
txt = do
  Time.MkSystemTime Int64
sec Word32
nano <- UTCTime -> SystemTime
Time.utcToSystemTime (UTCTime -> SystemTime) -> Maybe UTCTime -> Maybe SystemTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
utcM
  Timestamp -> Maybe Timestamp
forall (f :: * -> *) a. Applicative f => a -> f a
Hs.pure (Int64 -> Int32 -> Timestamp
Timestamp Int64
sec (Integer -> Int32
forall a. Num a => Integer -> a
Hs.fromInteger (Word32 -> Integer
forall a. Integral a => a -> Integer
Hs.toInteger Word32
nano)))
  where
    utcM :: Maybe UTCTime
utcM = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
Time.parseTimeM Bool
Hs.False TimeLocale
Time.defaultTimeLocale String
rfc3339Format (Text -> String
Text.unpack Text
txt)

toRFC3339 :: Timestamp -> Hs.Text
toRFC3339 :: Timestamp -> Text
toRFC3339 Timestamp
ts = String -> Text
Text.pack (TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
Time.defaultTimeLocale String
rfc3339Format (Timestamp -> UTCTime
toUTCTime Timestamp
ts))

instance HsJSONPB.ToJSONPB Timestamp where
  toJSONPB :: Timestamp -> Options -> Value
toJSONPB Timestamp
ts Options
_opt = Text -> Value
HsJSONPB.String (Text -> Text
Text.toStrict (Timestamp -> Text
toRFC3339 Timestamp
ts))

instance HsJSONPB.FromJSONPB Timestamp where
  parseJSONPB :: Value -> Parser Timestamp
parseJSONPB = String -> (Text -> Parser Timestamp) -> Value -> Parser Timestamp
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Timestamp" Text -> Parser Timestamp
forall (m :: * -> *). MonadPlus m => Text -> m Timestamp
tryParse
    where
      tryParse :: Text -> m Timestamp
tryParse Text
txt = m Timestamp
-> (Timestamp -> m Timestamp) -> Maybe Timestamp -> m Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
Hs.maybe m Timestamp
forall (m :: * -> *) a. MonadPlus m => m a
Hs.mzero Timestamp -> m Timestamp
forall (f :: * -> *) a. Applicative f => a -> f a
Hs.pure (Text -> Maybe Timestamp
fromRFC3339 (Text -> Text
Text.fromStrict Text
txt))

instance HsJSONPB.ToJSON Timestamp where
  toJSON :: Timestamp -> Value
toJSON = Timestamp -> Value
forall a. ToJSONPB a => a -> Value
HsJSONPB.toAesonValue
  toEncoding :: Timestamp -> Encoding
toEncoding = Timestamp -> Encoding
forall a. ToJSONPB a => a -> Encoding
HsJSONPB.toAesonEncoding

instance HsJSONPB.FromJSON Timestamp where
  parseJSON :: Value -> Parser Timestamp
parseJSON = Value -> Parser Timestamp
forall a. FromJSONPB a => Value -> Parser a
HsJSONPB.parseJSONPB

instance HsJSONPB.ToSchema Timestamp where
  declareNamedSchema :: Proxy Timestamp -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Timestamp
_ =
    do
      let declare_seconds :: Proxy (OverrideToSchema Int64)
-> Declare (Definitions Schema) (Referenced Schema)
declare_seconds = Proxy (OverrideToSchema Int64)
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
HsJSONPB.declareSchemaRef
      Referenced Schema
timestampSeconds <- Proxy (OverrideToSchema Int64)
-> Declare (Definitions Schema) (Referenced Schema)
declare_seconds Proxy (OverrideToSchema Int64)
forall k (t :: k). Proxy t
Proxy.Proxy
      let declare_nanos :: Proxy (OverrideToSchema Int32)
-> Declare (Definitions Schema) (Referenced Schema)
declare_nanos = Proxy (OverrideToSchema Int32)
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
HsJSONPB.declareSchemaRef
      Referenced Schema
timestampNanos <- Proxy (OverrideToSchema Int32)
-> Declare (Definitions Schema) (Referenced Schema)
declare_nanos Proxy (OverrideToSchema Int32)
forall k (t :: k). Proxy t
Proxy.Proxy
      let Proxy Timestamp
_ =
            Int64 -> Int32 -> Timestamp
Timestamp (Int64 -> Int32 -> Timestamp)
-> Proxy Int64 -> Proxy (Int32 -> Timestamp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Proxy (OverrideToSchema Int64)
 -> Declare (Definitions Schema) (Referenced Schema))
-> Proxy Int64
forall a b. (Proxy (OverrideToSchema a) -> b) -> Proxy a
HsJSONPB.asProxy Proxy (OverrideToSchema Int64)
-> Declare (Definitions Schema) (Referenced Schema)
declare_seconds
              Proxy (Int32 -> Timestamp) -> Proxy Int32 -> Proxy Timestamp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Proxy (OverrideToSchema Int32)
 -> Declare (Definitions Schema) (Referenced Schema))
-> Proxy Int32
forall a b. (Proxy (OverrideToSchema a) -> b) -> Proxy a
HsJSONPB.asProxy Proxy (OverrideToSchema Int32)
-> Declare (Definitions Schema) (Referenced Schema)
declare_nanos
      NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
Hs.return
        ( NamedSchema :: Maybe Text -> Schema -> NamedSchema
HsJSONPB.NamedSchema
            { _namedSchemaName :: Maybe Text
HsJSONPB._namedSchemaName =
                Text -> Maybe Text
forall a. a -> Maybe a
Hs.Just Text
"Timestamp",
              _namedSchemaSchema :: Schema
HsJSONPB._namedSchemaSchema =
                Schema
forall a. Monoid a => a
Hs.mempty
                  { _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
HsJSONPB._schemaParamSchema =
                      ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
Hs.mempty
                        { _paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
HsJSONPB._paramSchemaType =
                            SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Hs.Just SwaggerType 'SwaggerKindSchema
HsJSONPB.SwaggerObject
                        },
                    _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
HsJSONPB._schemaProperties =
                      [(Text, Referenced Schema)]
-> InsOrdHashMap Text (Referenced Schema)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
HsJSONPB.insOrdFromList
                        [ (Text
"seconds", Referenced Schema
timestampSeconds),
                          (Text
"nanos", Referenced Schema
timestampNanos)
                        ]
                  }
            }
        )