Param.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}

{- HLINT ignore "Redundant flip" -}

module Data.RdsData.Encode.Param
  ( EncodeParam(..)

  , rdsParam

  , named
  , typed

  , maybe

  , array
  , bool
  , bytestring
  , double
  , integer
  , null
  , text

  , base64
  , day
  , int
  , int8
  , int16
  , int32
  , int64
  , json
  , lazyBytestring
  , lazyText
  , timeOfDay
  , utcTime
  , uuid
  , word
  , word8
  , word16
  , word32
  , word64
  ) where

import Control.Lens
import Data.ByteString (ByteString)
import Data.Functor.Contravariant
import Data.Generics.Product.Any
import Data.Int
import Data.RdsData.Encode.Array
import Data.RdsData.Types.Value
import Data.RdsData.Types.Param
import Data.Text (Text)
import Data.Time
import Data.UUID (UUID)
import Data.Word
import Prelude hiding (maybe, null)

import qualified Amazonka.Bytes                 as AWS
import qualified Amazonka.Data.Base64           as AWS
import qualified Amazonka.RDSData               as AWS
import qualified Data.Aeson                     as J
import qualified Data.ByteString.Lazy           as LBS
import qualified Data.RdsData.Internal.Convert  as CONV
import qualified Data.Text.Lazy                 as LT
import qualified Prelude                        as P

newtype EncodeParam a = EncodeParam
  { encodeParam :: a -> Param
  }

instance Contravariant EncodeParam where
  contramap f (EncodeParam g) =
    EncodeParam (g . f)

--------------------------------------------------------------------------------

named :: Text -> EncodeParam a -> EncodeParam a
named n (EncodeParam f) =
  EncodeParam \a -> f a & the @"name" .~ Just n

typed :: AWS.TypeHint -> EncodeParam a -> EncodeParam a
typed t (EncodeParam f) =
  EncodeParam \a -> f a & the @"hint" .~ Just t

rdsParam :: EncodeParam Param
rdsParam =
  EncodeParam id

--------------------------------------------------------------------------------

maybe :: EncodeParam a -> EncodeParam (Maybe a)
maybe =
  EncodeParam . P.maybe (Param Nothing Nothing ValueOfNull) . encodeParam

--------------------------------------------------------------------------------

array :: EncodeArray a -> EncodeParam a
array enc =
  Param Nothing Nothing . ValueOfArray . encodeArray enc >$< rdsParam

base64 :: EncodeParam AWS.Base64
base64 =
  Param Nothing Nothing . ValueOfBase64 >$< rdsParam

bool :: EncodeParam Bool
bool =
  Param Nothing Nothing . ValueOfBool >$< rdsParam

double :: EncodeParam Double
double =
  Param Nothing Nothing . ValueOfDouble >$< rdsParam

null :: EncodeParam ()
null =
  Param Nothing Nothing . const ValueOfNull >$< rdsParam

integer :: EncodeParam Integer
integer =
  Param Nothing Nothing . ValueOfInteger >$< rdsParam

text :: EncodeParam Text
text =
  Param Nothing Nothing . ValueOfText >$< rdsParam

--------------------------------------------------------------------------------

int :: EncodeParam Int
int =
  fromIntegral >$< integer

int8 :: EncodeParam Int8
int8 =
  fromIntegral >$< integer

int16 :: EncodeParam Int16
int16 =
  fromIntegral >$< integer

int32 :: EncodeParam Int32
int32 =
  fromIntegral >$< integer

int64 :: EncodeParam Int64
int64 =
  fromIntegral >$< integer

word :: EncodeParam Word
word =
  fromIntegral >$< integer

word8 :: EncodeParam Word8
word8 =
  fromIntegral >$< integer

word16 :: EncodeParam Word16
word16 =
  fromIntegral >$< integer

word32 :: EncodeParam Word32
word32 =
  fromIntegral >$< integer

word64 :: EncodeParam Word64
word64 =
  fromIntegral >$< integer

lazyText :: EncodeParam LT.Text
lazyText =
  LT.toStrict >$< text

bytestring :: EncodeParam ByteString
bytestring =
  (AWS.Base64 . AWS.encodeBase64) >$< base64

lazyBytestring :: EncodeParam LBS.ByteString
lazyBytestring =
  LBS.toStrict >$< bytestring

timeOfDay :: EncodeParam TimeOfDay
timeOfDay =
  CONV.timeOfDayToText >$< text & typed AWS.TypeHint_TIME

day :: EncodeParam Day
day =
  CONV.dayToText >$< text & typed AWS.TypeHint_DATE

json :: EncodeParam J.Value
json =
  CONV.jsonToText >$< text & typed AWS.TypeHint_JSON

utcTime :: EncodeParam UTCTime
utcTime =
  CONV.utcTimeToText >$< text & typed AWS.TypeHint_TIMESTAMP

uuid :: EncodeParam UUID
uuid =
  CONV.uuidToText >$< text & typed AWS.TypeHint_UUID