module Sqel.Codec where import qualified Chronos as Chronos import Data.Time (Day, DiffTime, LocalTime, TimeOfDay, TimeZone, UTCTime) import Data.UUID (UUID) import qualified Hasql.Decoders as Hasql import qualified Hasql.Decoders as Decoders import Hasql.Decoders (Row, custom) import qualified Hasql.Encoders as Encoders import Hasql.Encoders (Params) import Path (Path) import qualified Sqel.Codec.PrimDecoder as PrimDecoder import Sqel.Codec.PrimDecoder (PrimDecoder) import qualified Sqel.Codec.PrimEncoder as PrimEncoder import Sqel.Codec.PrimEncoder (PrimEncoder) import Sqel.Codec.Sum (ignoreEncoder) import qualified Sqel.Data.Codec as Codec import Sqel.Data.Codec (Codec (Codec), Decoder (Decoder), Encoder (Encoder), FullCodec, ValueCodec) import Sqel.Data.PgType (PgPrimName) import Sqel.SOP.Error (Quoted, QuotedType) ignoreDecoder :: Row (Maybe a) ignoreDecoder = join <$> Hasql.column (Hasql.nullable (custom \ _ _ -> pure Nothing)) class ColumnEncoder f where columnEncoder :: f a -> Params a columnEncoderNullable :: f a -> Params (Maybe a) columnEncoderIgnore :: f a -> Params b instance ColumnEncoder Encoders.Value where columnEncoder = Encoders.param . Encoders.nonNullable columnEncoderNullable = Encoders.param . Encoders.nullable columnEncoderIgnore = ignoreEncoder class ColumnDecoder f where columnDecoder :: f a -> Row a columnDecoderNullable :: f a -> Row (Maybe a) instance ColumnDecoder Decoders.Value where columnDecoder = Decoders.column . Decoders.nonNullable columnDecoderNullable = Decoders.column . Decoders.nullable class PrimColumn a where primDecoder :: Decoders.Value a default primDecoder :: PrimDecoder a => Decoders.Value a primDecoder = PrimDecoder.primDecoder primEncoder :: Encoders.Value a default primEncoder :: PrimEncoder a => Encoders.Value a primEncoder = PrimEncoder.primEncoder pgType :: PgPrimName instance {-# overlappable #-} ( TypeError ( "A column of type " <> QuotedType a <> " was declared as primitive," % "but there is no instance of " <> Quoted "PrimColumn" <> " for that type." % "If it is a newtype, ensure that it has " <> Quoted "Generic" <> " and use " <> Quoted "primNewtype" <> "." ) ) => PrimColumn a where primDecoder = error "no instance for PrimColumn" primEncoder = error "no instance for PrimColumn" pgType = error "no instance for PrimColumn" instance PrimColumn Bool where pgType = "boolean" instance PrimColumn Int where pgType = "bigint" instance PrimColumn Int64 where pgType = "bigint" instance PrimColumn Double where pgType = "double precision" instance PrimColumn Text where pgType = "text" instance PrimColumn ByteString where pgType = "bytes" instance PrimColumn UUID where pgType = "uuid" instance PrimColumn Day where pgType = "date" instance PrimColumn LocalTime where pgType = "timestamp without time zone" instance PrimColumn UTCTime where pgType = "timestamp with time zone" instance PrimColumn TimeOfDay where pgType = "time without time zone" instance PrimColumn (TimeOfDay, TimeZone) where pgType = "time with time zone" instance PrimColumn DiffTime where pgType = "interval" instance PrimColumn Chronos.Date where pgType = "date" instance PrimColumn Chronos.Time where pgType = "bigint" instance PrimColumn Chronos.Datetime where pgType = "timestamp without time zone" instance PrimDecoder (Path b t) => PrimColumn (Path b t) where pgType = "text" instance PrimColumn () where pgType = "boolean" fullPrimCodec :: Encoders.Value a -> Decoders.Value a -> FullCodec a fullPrimCodec encoder decoder = Codec { encoder = Encoder (columnEncoder encoder) (columnEncoderIgnore encoder), decoder = Decoder (columnDecoder decoder) (void ignoreDecoder) } toFullPrimCodec :: ValueCodec a -> FullCodec a toFullPrimCodec (Codec encoder decoder) = fullPrimCodec encoder decoder