{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}

module Database.Relational.NonStandard.PureTimestampTZ () where

import Control.Applicative (pure)
import Data.Time (UTCTime, ZonedTime)

import Language.SQL.Keyword (Keyword (..))

import qualified Database.Relational.Internal.Literal as Lit

import Database.Relational.ProjectableClass (LiteralSQL (..))


-- | Constant SQL terms of 'ZonedTime'.
--   This generates ***NOT STANDARD*** SQL of TIMESTAMPTZ literal.
instance LiteralSQL ZonedTime where
  showLiteral' :: ZonedTime -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (ZonedTime -> StringSQL) -> ZonedTime -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringSQL -> String -> ZonedTime -> StringSQL
forall t. FormatTime t => StringSQL -> String -> t -> StringSQL
Lit.timestamp StringSQL
TIMESTAMPTZ String
"%Y-%m-%d %H:%M:%S%z"

-- | Constant SQL terms of 'UTCTime'.
--   This generates ***NOT STANDARD*** SQL of TIMESTAMPTZ literal with UTC timezone.
instance LiteralSQL UTCTime where
  showLiteral' :: UTCTime -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (UTCTime -> StringSQL) -> UTCTime -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringSQL -> String -> UTCTime -> StringSQL
forall t. FormatTime t => StringSQL -> String -> t -> StringSQL
Lit.timestamp StringSQL
TIMESTAMPTZ String
"%Y-%m-%d %H:%M:%S%z"