Codec.hs

module Hasql.Generate.Codec
    ( PgCodec (..)
    ) where

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

import qualified Data.Aeson                 as Aeson
import           Data.Bool                  ( Bool )
import           Data.ByteString            ( ByteString )
import           Data.Char                  ( Char )
import           Data.Functor               ( fmap )
import qualified Data.Functor.Contravariant as Contravariant
import           Data.Int                   ( Int16, Int32, Int64 )
import           Data.Scientific            ( Scientific )
import           Data.String                ( String )
import           Data.Text                  ( Text )
import qualified Data.Text
import           Data.Time
    ( Day
    , DiffTime
    , LocalTime
    , TimeOfDay
    , TimeZone
    , UTCTime
    )
import           Data.UUID                  ( UUID )

import qualified Hasql.Decoders             as Decoders
import qualified Hasql.Encoders             as Encoders

import           Prelude                    ( Double, Float )

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

{-  Typeclass mapping a Haskell type to its hasql binary-protocol encoder and
    decoder. Each instance pairs a type with the corresponding hasql 'Value'
    encoder and decoder, enabling the TH code generator to resolve codecs by
    type inference alone.
-}
class PgCodec a where
  pgDecode :: Decoders.Value a
  pgEncode :: Encoders.Value a

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

instance PgCodec Bool where
  pgDecode :: Decoders.Value Bool
  pgDecode = Decoders.bool
  pgEncode :: Encoders.Value Bool
  pgEncode = Encoders.bool

instance PgCodec Int16 where
  pgDecode :: Decoders.Value Int16
  pgDecode = Decoders.int2
  pgEncode :: Encoders.Value Int16
  pgEncode = Encoders.int2

instance PgCodec Int32 where
  pgDecode :: Decoders.Value Int32
  pgDecode = Decoders.int4
  pgEncode :: Encoders.Value Int32
  pgEncode = Encoders.int4

instance PgCodec Int64 where
  pgDecode :: Decoders.Value Int64
  pgDecode = Decoders.int8
  pgEncode :: Encoders.Value Int64
  pgEncode = Encoders.int8

instance PgCodec Float where
  pgDecode :: Decoders.Value Float
  pgDecode = Decoders.float4
  pgEncode :: Encoders.Value Float
  pgEncode = Encoders.float4

instance PgCodec Double where
  pgDecode :: Decoders.Value Double
  pgDecode = Decoders.float8
  pgEncode :: Encoders.Value Double
  pgEncode = Encoders.float8

instance PgCodec Scientific where
  pgDecode :: Decoders.Value Scientific
  pgDecode = Decoders.numeric
  pgEncode :: Encoders.Value Scientific
  pgEncode = Encoders.numeric

instance PgCodec Char where
  pgDecode :: Decoders.Value Char
  pgDecode = Decoders.char
  pgEncode :: Encoders.Value Char
  pgEncode = Encoders.char

instance PgCodec Text where
  pgDecode :: Decoders.Value Text
  pgDecode = Decoders.text
  pgEncode :: Encoders.Value Text
  pgEncode = Encoders.text

instance PgCodec String where
  pgDecode :: Decoders.Value String
  pgDecode = fmap Data.Text.unpack Decoders.text
  pgEncode :: Encoders.Value String
  pgEncode = Contravariant.contramap Data.Text.pack Encoders.text

instance PgCodec ByteString where
  pgDecode :: Decoders.Value ByteString
  pgDecode = Decoders.bytea
  pgEncode :: Encoders.Value ByteString
  pgEncode = Encoders.bytea

instance PgCodec Day where
  pgDecode :: Decoders.Value Day
  pgDecode = Decoders.date
  pgEncode :: Encoders.Value Day
  pgEncode = Encoders.date

instance PgCodec LocalTime where
  pgDecode :: Decoders.Value LocalTime
  pgDecode = Decoders.timestamp
  pgEncode :: Encoders.Value LocalTime
  pgEncode = Encoders.timestamp

instance PgCodec UTCTime where
  pgDecode :: Decoders.Value UTCTime
  pgDecode = Decoders.timestamptz
  pgEncode :: Encoders.Value UTCTime
  pgEncode = Encoders.timestamptz

instance PgCodec TimeOfDay where
  pgDecode :: Decoders.Value TimeOfDay
  pgDecode = Decoders.time
  pgEncode :: Encoders.Value TimeOfDay
  pgEncode = Encoders.time

instance PgCodec (TimeOfDay, TimeZone) where
  pgDecode :: Decoders.Value (TimeOfDay, TimeZone)
  pgDecode = Decoders.timetz
  pgEncode :: Encoders.Value (TimeOfDay, TimeZone)
  pgEncode = Encoders.timetz

instance PgCodec DiffTime where
  pgDecode :: Decoders.Value DiffTime
  pgDecode = Decoders.interval
  pgEncode :: Encoders.Value DiffTime
  pgEncode = Encoders.interval

instance PgCodec UUID where
  pgDecode :: Decoders.Value UUID
  pgDecode = Decoders.uuid
  pgEncode :: Encoders.Value UUID
  pgEncode = Encoders.uuid

instance PgCodec Aeson.Value where
  pgDecode :: Decoders.Value Aeson.Value
  pgDecode = Decoders.jsonb
  pgEncode :: Encoders.Value Aeson.Value
  pgEncode = Encoders.jsonb