@@ -1,26 +1,80 @@
11{-# LANGUAGE
2− DefaultSignatures
2+ DataKinds
3+ , DefaultSignatures
34 , FlexibleContexts
5+ , FlexibleInstances
46 , GADTs
7+ , KindSignatures
58 , MultiParamTypeClasses
9+ , ScopedTypeVariables
610#-}
711
812module Squeel.PostgreSQL.Binary2 where
913
14+import Data.Int
15+import Data.Scientific
16+import Data.Time
17+import Data.Word
18+import Data.UUID
1019import Generics.SOP
20+import Network.IP.Addr
1121
22+import qualified Data.ByteString.Lazy as Lazy
23+import qualified Data.ByteString as Strict
24+import qualified Data.Text.Lazy as Lazy
25+import qualified Data.Text as Strict
1226import qualified PostgreSQL.Binary.Decoding as Decoding
1327import qualified PostgreSQL.Binary.Encoding as Encoding
1428
15−class ToParam x pg where
16− toParam :: x -> K Encoding.Encoding pg
17−class ToParams x pgs where
18− toParams :: x -> NP (K Encoding.Encoding) pgs
29+import Squeel.PostgreSQL.Schema
30+
31+class ToParam x (pg :: PGType) where toParam :: x -> K Encoding.Encoding pg
32+instance ToParam Bool 'PGBool where toParam = K . Encoding.bool
33+instance ToParam Int16 'PGInt2 where toParam = K . Encoding.int2_int16
34+instance ToParam Word16 'PGInt2 where toParam = K . Encoding.int2_word16
35+instance ToParam Int32 'PGInt4 where toParam = K . Encoding.int4_int32
36+instance ToParam Word32 'PGInt4 where toParam = K . Encoding.int4_word32
37+instance ToParam Int64 'PGInt8 where toParam = K . Encoding.int8_int64
38+instance ToParam Word64 'PGInt8 where toParam = K . Encoding.int8_word64
39+instance ToParam Float 'PGFloat4 where toParam = K . Encoding.float4
40+instance ToParam Double 'PGFloat8 where toParam = K . Encoding.float8
41+instance ToParam Scientific 'PGNumeric where toParam = K . Encoding.numeric
42+instance ToParam UUID 'PGUuid where toParam = K . Encoding.uuid
43+instance ToParam (NetAddr IP) 'PGInet where toParam = K . Encoding.inet
44+instance ToParam Char ('PGChar 1) where toParam = K . Encoding.char_utf8
45+instance ToParam Strict.Text 'PGText where toParam = K . Encoding.text_strict
46+instance ToParam Lazy.Text 'PGText where toParam = K . Encoding.text_lazy
47+instance ToParam Strict.ByteString 'PGBytea where
48+ toParam = K . Encoding.bytea_strict
49+instance ToParam Lazy.ByteString 'PGBytea where
50+ toParam = K . Encoding.bytea_lazy
51+instance ToParam Day 'PGDate where toParam = K . Encoding.date
52+instance ToParam TimeOfDay 'PGTime where toParam = K . Encoding.time_int
53+instance ToParam (TimeOfDay, TimeZone) 'PGTimeTZ where
54+ toParam = K . Encoding.timetz_int
55+instance ToParam LocalTime 'PGTimestamp where
56+ toParam = K . Encoding.timestamp_int
57+instance ToParam UTCTime 'PGTimestampTZ where
58+ toParam = K . Encoding.timestamptz_int
59+instance ToParam DiffTime 'PGInterval where toParam = K . Encoding.interval_int
60+
61+class ToColumnParam x (ty :: ColumnType) where
62+ toColumnParam :: x -> K (Maybe Encoding.Encoding) ty
63+instance ToParam x pg => ToColumnParam x ('Required ('NotNull pg)) where
64+ toColumnParam = K . Just . unK . (toParam :: x -> K Encoding.Encoding pg)
65+instance ToParam x pg => ToColumnParam (Maybe x) ('Required ('Null pg)) where
66+ toColumnParam = K . fmap (unK . (toParam :: x -> K Encoding.Encoding pg))
67+instance ToParam x pg => ToColumnParam (Maybe x) ('Optional (nullity pg)) where
68+ toColumnParam = K . fmap (unK . (toParam :: x -> K Encoding.Encoding pg))
69+
70+class ToParams x (tys :: [ColumnType]) where
71+ toParams :: x -> NP (K (Maybe Encoding.Encoding)) tys
1972 default toParams
20− :: (IsProductType x xs, AllZip ToParam xs pgs)
21− => x -> NP (K Encoding.Encoding) pgs
73+ :: (IsProductType x xs, AllZip ToColumnParam xs tys)
74+ => x -> NP (K (Maybe Encoding.Encoding)) tys
2275 toParams
23− = htrans (Proxy :: Proxy ToParam) (toParam . unI) . unZ . unSOP . from
76+ = htrans (Proxy :: Proxy ToColumnParam) (toColumnParam . unI)
77+ . unZ . unSOP . from
2478
2579class FromValue pg y where
2680 fromValue :: proxy pg -> Decoding.Value y