git.iko.soy/squeal
on dev help sign in
encoding code
4b18ff5Eitan Chatav
squeel-postgresql/squeel-postgresql.cabal+2−1
compare with dev
unifiedsplit
@@ -20,7 +20,7 @@ library
20 Squeel.PostgreSQL.Statement
20 Squeel.PostgreSQL.Statement
21 Squeel.PostgreSQL.Schema
21 Squeel.PostgreSQL.Schema
22 default-language: Haskell2010
22 default-language: Haskell2010
23− ghc-options: -Wall -Werror
23+ ghc-options: -Wall -Werror -fprint-explicit-kinds
24 build-depends:
24 build-depends:
25 aeson
25 aeson
26 , base
26 , base
@@ -29,6 +29,7 @@ library
29 , lifted-base
29 , lifted-base
30 , monad-control
30 , monad-control
31 , mtl
31 , mtl
32+ , network-ip
32 , postgresql-binary
33 , postgresql-binary
33 , postgresql-libpq
34 , postgresql-libpq
34 , scientific
35 , scientific
squeel-postgresql/src/Squeel/PostgreSQL/Binary2.hs+62−8
@@ -1,26 +1,80 @@
1{-# LANGUAGE
1{-# LANGUAGE
2+ DataKinds
2− DefaultSignatures
3+ , DefaultSignatures
3 , FlexibleContexts
4 , FlexibleContexts
5+ , FlexibleInstances
4 , GADTs
6 , GADTs
7+ , KindSignatures
5 , MultiParamTypeClasses
8 , MultiParamTypeClasses
9+ , ScopedTypeVariables
6#-}
10#-}
7
11
8module Squeel.PostgreSQL.Binary2 where
12module Squeel.PostgreSQL.Binary2 where
9
13
14+import Data.Int
15+import Data.Scientific
16+import Data.Time
17+import Data.Word
18+import Data.UUID
10import Generics.SOP
19import Generics.SOP
20+import Network.IP.Addr
11
21
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
12import qualified PostgreSQL.Binary.Decoding as Decoding
26import qualified PostgreSQL.Binary.Decoding as Decoding
13import qualified PostgreSQL.Binary.Encoding as Encoding
27import qualified PostgreSQL.Binary.Encoding as Encoding
14
28
29+import Squeel.PostgreSQL.Schema
30+
15−class ToParam x pg where
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
16− toParam :: x -> K Encoding.Encoding pg
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+
17−class ToParams x pgs where
70+class ToParams x (tys :: [ColumnType]) where
18− toParams :: x -> NP (K Encoding.Encoding) pgs
71+ toParams :: x -> NP (K (Maybe Encoding.Encoding)) tys
19 default toParams
72 default toParams
20− :: (IsProductType x xs, AllZip ToParam xs pgs)
73+ :: (IsProductType x xs, AllZip ToColumnParam xs tys)
21− => x -> NP (K Encoding.Encoding) pgs
74+ => x -> NP (K (Maybe Encoding.Encoding)) tys
22 toParams
75 toParams
23− = htrans (Proxy :: Proxy ToParam) (toParam . unI) . unZ . unSOP . from
76+ = htrans (Proxy :: Proxy ToColumnParam) (toColumnParam . unI)
77+ . unZ . unSOP . from
24
78
25class FromValue pg y where
79class FromValue pg y where
26 fromValue :: proxy pg -> Decoding.Value y
80 fromValue :: proxy pg -> Decoding.Value y
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+1−3
@@ -58,9 +58,6 @@ data PGType
58 | PGNumeric
58 | PGNumeric
59 | PGFloat4
59 | PGFloat4
60 | PGFloat8
60 | PGFloat8
61− | PGSerial2
62− | PGSerial4
63− | PGSerial8
64 | PGMoney
61 | PGMoney
65 | PGChar Nat
62 | PGChar Nat
66 | PGVarChar Nat
63 | PGVarChar Nat
@@ -73,6 +70,7 @@ data PGType
73 | PGTimeTZ
70 | PGTimeTZ
74 | PGInterval
71 | PGInterval
75 | PGUuid
72 | PGUuid
73+ | PGInet
76 | PGJson
74 | PGJson
77 | PGJsonb
75 | PGJsonb
78
76