rds-data-0.0.0.9: src/Data/RdsData/Encode/Params.hs

{-# LANGUAGE BlockArguments #-}

module Data.RdsData.Encode.Params
  ( EncodeParams(..)

  , rdsValue

  , column

  , maybe

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

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

import           Data.ByteString                      (ByteString)
import           Data.Functor.Contravariant
import           Data.Functor.Contravariant.Divisible
import           Data.Int
import           Data.RdsData.Encode.Array            (EncodeArray (..))
import           Data.RdsData.Encode.Param            (EncodeParam (..))
import           Data.RdsData.Types.Param
import           Data.Text                            (Text)
import           Data.Time
import           Data.ULID                            (ULID)
import           Data.UUID                            (UUID)
import           Data.Void
import           Data.Word
import           Prelude                              hiding (maybe, null)

import qualified Amazonka.Data.Base64                 as AWS
import qualified Data.Aeson                           as J
import qualified Data.ByteString.Lazy                 as LBS
import qualified Data.RdsData.Encode.Param            as EP
import qualified Data.Text.Lazy                       as LT
import qualified Prelude                              as P

newtype EncodeParams a = EncodeParams
  { encodeParams :: a -> [Param] -> [Param]
  }

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

instance Divisible EncodeParams where
  divide f (EncodeParams g) (EncodeParams h) =
    EncodeParams \a ->
      case f a of
        (b, c) -> g b . h c
  conquer =
    EncodeParams $ const id

instance Decidable EncodeParams where
  choose f (EncodeParams g) (EncodeParams h) =
    EncodeParams \a ->
      case f a of
        Left b  -> g b
        Right c -> h c
  lose f =
    EncodeParams $ absurd . f

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

rdsValue :: EncodeParams Param
rdsValue =
  EncodeParams (:)

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

column :: EncodeParam a -> EncodeParams a
column (EncodeParam f) =
  EncodeParams \a -> (f a:)

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

maybe :: EncodeParams a -> EncodeParams (Maybe a)
maybe =
  choose (P.maybe (Left ()) Right) null

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

array :: EncodeArray a -> EncodeParams a
array =
  column . EP.array

base64 :: EncodeParams AWS.Base64
base64 =
  column EP.base64

bool :: EncodeParams Bool
bool =
  column EP.bool

double :: EncodeParams Double
double =
  column EP.double

null :: EncodeParams ()
null =
  column EP.null

integer :: EncodeParams Integer
integer =
  column EP.integer

text :: EncodeParams Text
text =
  column EP.text

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

int :: EncodeParams Int
int =
  column EP.int

int8 :: EncodeParams Int8
int8 =
  column EP.int8

int16 :: EncodeParams Int16
int16 =
  column EP.int16

int32 :: EncodeParams Int32
int32 =
  column EP.int32

int64 :: EncodeParams Int64
int64 =
  column EP.int64

word :: EncodeParams Word
word =
  column EP.word

word8 :: EncodeParams Word8
word8 =
  column EP.word8

word16 :: EncodeParams Word16
word16 =
  column EP.word16

word32 :: EncodeParams Word32
word32 =
  column EP.word32

word64 :: EncodeParams Word64
word64 =
  column EP.word64

lazyText :: EncodeParams LT.Text
lazyText =
  column EP.lazyText

bytestring :: EncodeParams ByteString
bytestring =
  column EP.bytestring

lazyBytestring :: EncodeParams LBS.ByteString
lazyBytestring =
  column EP.lazyBytestring

base64Text :: EncodeParams ByteString
base64Text =
  column EP.base64Text

lazyBase64Text :: EncodeParams LBS.ByteString
lazyBase64Text =
  column EP.lazyBase64Text

timeOfDay :: EncodeParams TimeOfDay
timeOfDay =
  column EP.timeOfDay

day :: EncodeParams Day
day =
  column EP.day

json :: EncodeParams J.Value
json =
  column EP.json

ulid :: EncodeParams ULID
ulid =
  column EP.ulid

utcTime :: EncodeParams UTCTime
utcTime =
  column EP.utcTime

uuid :: EncodeParams UUID
uuid =
  column EP.uuid