Value.hs

{-# LANGUAGE BlockArguments #-}

module Data.RdsData.Encode.Value
  ( EncodeValue(..)

  , rdsValue

  , maybe

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

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

import           Data.ByteString               (ByteString)
import           Data.Functor.Contravariant
import           Data.Int
import           Data.RdsData.Encode.Array
import           Data.RdsData.Types.Value
import           Data.Text                     (Text)
import           Data.Time
import           Data.ULID                     (ULID)
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 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 EncodeValue a = EncodeValue
  { encodeValue :: a -> Value
  }

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

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

rdsValue :: EncodeValue Value
rdsValue =
  EncodeValue id

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

maybe :: EncodeValue a -> EncodeValue (Maybe a)
maybe =
  EncodeValue . P.maybe ValueOfNull . (.encodeValue)

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

array :: EncodeArray a -> EncodeValue a
array enc =
  ValueOfArray . enc.encodeArray >$< rdsValue

base64 :: EncodeValue AWS.Base64
base64 =
  ValueOfBase64 >$< rdsValue

bool :: EncodeValue Bool
bool =
  ValueOfBool >$< rdsValue

double :: EncodeValue Double
double =
  ValueOfDouble >$< rdsValue

null :: EncodeValue ()
null =
  const ValueOfNull >$< rdsValue

integer :: EncodeValue Integer
integer =
  ValueOfInteger >$< rdsValue

text :: EncodeValue Text
text =
  ValueOfText >$< rdsValue

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

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

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

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

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

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

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

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

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

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

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

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

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

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

timeOfDay :: EncodeValue TimeOfDay
timeOfDay =
  CONV.timeOfDayToText >$< text

day :: EncodeValue Day
day =
  CONV.dayToText >$< text

json :: EncodeValue J.Value
json =
  CONV.jsonToText >$< text

utcTime :: EncodeValue UTCTime
utcTime =
  CONV.utcTimeToText >$< text

ulid :: EncodeValue ULID
ulid =
  CONV.ulidToText >$< text

uuid :: EncodeValue UUID
uuid =
  CONV.uuidToText >$< text