git.iko.soy/squeal
on dev help sign in
rejigger postgres types
commitb54230aac27213c3953b648bcd3512dce9066453 authorEitan Chatav <eitan.chatav@gmail.com> dateThu 6 Apr 2017, 13:51 (10 years ago) parent22ec950
6 files changed+90−273
compare with dev
unifiedsplit
squeel-postgresql/squeel-postgresql.cabal−2 squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+11−11 squeel-postgresql/src/Squeel/PostgreSQL/Type.hs+30−4 squeel-postgresql/src/Squeel/PostgreSQL/Type2.hs−66 squeel-postgresql/src/Squeel/PostgreSQL/Value.hs+49−52 squeel-postgresql/src/Squeel/PostgreSQL/Value2.hs−138
squeel-postgresql/squeel-postgresql.cabal−2
@@ -17,9 +17,7 @@ library
1717 Squeel.PostgreSQL.PQ
1818 Squeel.PostgreSQL.Query
1919 Squeel.PostgreSQL.Type
20− Squeel.PostgreSQL.Type2
2120 Squeel.PostgreSQL.Value
22− Squeel.PostgreSQL.Value2
2321 default-language: Haskell2010
2422 ghc-options: -Wall -Werror
2523 build-depends: base
squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+11−11
@@ -52,7 +52,7 @@ whenThen (Expression when_,Expression then_) = mconcat
5252 [" WHEN ",when_," THEN ",then_,"\n"]
5353
5454case_
55− :: [(Expression ps cols ('PGType "bool"),Expression ps cols x)]
55+ :: [(Expression ps cols 'PGBool,Expression ps cols x)]
5656 -> Expression ps cols x
5757 -> Expression ps cols x
5858case_ whens (Expression else_) = Expression $ mconcat
@@ -82,52 +82,52 @@ column = \case
8282 As x -> x
8383 Elem -> Expression $ Char8.pack (symbolVal (Proxy @colName))
8484
85−true :: Expression ps cols ('PGType "bool")
85+true :: Expression ps cols 'PGBool
8686true = Expression "true"
8787
88−false :: Expression ps cols ('PGType "bool")
88+false :: Expression ps cols 'PGBool
8989false = Expression "false"
9090
9191(.==)
9292 :: Expression ps cols x
9393 -> Expression ps cols x
94− -> Expression ps cols ('PGType "bool")
94+ -> Expression ps cols 'PGBool
9595(.==) (Expression x1) (Expression x2) = Expression $ x1 <> "=" <> x2
9696
9797(./=)
9898 :: Expression ps cols x
9999 -> Expression ps cols x
100− -> Expression ps cols ('PGType "bool")
100+ -> Expression ps cols 'PGBool
101101(./=) (Expression x1) (Expression x2) = Expression $ x1 <> "<>" <> x2
102102
103103(.>)
104104 :: Expression ps cols x
105105 -> Expression ps cols x
106− -> Expression ps cols ('PGType "bool")
106+ -> Expression ps cols 'PGBool
107107(.>) (Expression x1) (Expression x2) = Expression $ x1 <> ">" <> x2
108108
109109(.<)
110110 :: Expression ps cols x
111111 -> Expression ps cols x
112− -> Expression ps cols ('PGType "bool")
112+ -> Expression ps cols 'PGBool
113113(.<) (Expression x1) (Expression x2) = Expression $ x1 <> "<" <> x2
114114
115115(.>=)
116116 :: Expression ps cols x
117117 -> Expression ps cols x
118− -> Expression ps cols ('PGType "bool")
118+ -> Expression ps cols 'PGBool
119119(.>=) (Expression x1) (Expression x2) = Expression $ x1 <> ">=" <> x2
120120
121121(.<=)
122122 :: Expression ps cols x
123123 -> Expression ps cols x
124− -> Expression ps cols ('PGType "bool")
124+ -> Expression ps cols 'PGBool
125125(.<=) (Expression x1) (Expression x2) = Expression $ x1 <> "<=" <> x2
126126
127−instance IsString (Expression ps cols ('PGType "text")) where
127+instance IsString (Expression ps cols 'PGText) where
128128 fromString str = Expression $ "\'" <> fromString str <> "\'"
129129
130−instance Num (Expression ps cols ('PGType "int4")) where
130+instance Num (Expression ps cols 'PGInt4) where
131131 fromInteger n = Expression . fromString $ show n
132132 Expression x + Expression y = Expression $ x <> "+" <> y
133133 Expression x * Expression y = Expression $ x <> "*" <> y
squeel-postgresql/src/Squeel/PostgreSQL/Type.hs+30−4
@@ -11,13 +11,39 @@
1111module Squeel.PostgreSQL.Type where
1212
1313import Data.Proxy
14−import qualified Database.PostgreSQL.LibPQ as LibPQ
1514import GHC.TypeLits
1615
17−newtype PGType = PGType Symbol
18−data Named x = (:=) Symbol x
16+import qualified Database.PostgreSQL.LibPQ as LibPQ
17+
18+data PGType
19+ = PGBool
20+ | PGInt2
21+ | PGInt4
22+ | PGInt8
23+ | PGNumeric
24+ | PGFloat4
25+ | PGFloat8
26+ | PGSerial2
27+ | PGSerial4
28+ | PGSerial8
29+ | PGMoney
30+ | PGChar Nat
31+ | PGVarChar Nat
32+ | PGText
33+ | PGBytea
34+ | PGTimestamp
35+ | PGTimestampTZ
36+ | PGDate
37+ | PGTime
38+ | PGTimeTZ
39+ | PGInterval
40+ | PGUuid
41+ | PGJson
42+ | PGJsonb
43+
44+data Named k = (:=) Symbol k
1945type family Unnamed named where Unnamed (name ':= x) = x
20−type family Name x where Name (name ':= x) = name
46+type family Name k where Name (name ':= x) = name
2147type Column = Named PGType
2248type Table = Named [Column]
2349type Database = Named [Table]
squeel-postgresql/src/Squeel/PostgreSQL/Type2.hsdeleted−66
@@ -1,66 +0,0 @@
1−{-# LANGUAGE
2− DataKinds
3− , GADTs
4− , PolyKinds
5− , ScopedTypeVariables
6− , TypeApplications
7− , TypeFamilies
8− , TypeOperators
9−#-}
10−
11−module Squeel.PostgreSQL.Type2 where
12−
13−import Data.Proxy
14−import GHC.TypeLits
15−
16−import qualified Database.PostgreSQL.LibPQ as LibPQ
17−
18−data PGType
19− = PGBool
20− | PGInt2
21− | PGInt4
22− | PGInt8
23− | PGNumeric
24− | PGFloat4
25− | PGFloat8
26− | PGSerial2
27− | PGSerial4
28− | PGSerial8
29− | PGMoney
30− | PGChar Nat
31− | PGVarChar Nat
32− | PGText
33− | PGBytea
34− | PGTimestamp
35− | PGTimestampTZ
36− | PGDate
37− | PGTime
38− | PGTimeTZ
39− | PGInterval
40− | PGUuid
41− | PGJson
42− | PGJsonb
43−
44−data Named k = (:=) Symbol k
45−type family Unnamed named where Unnamed (name ':= x) = x
46−type family Name k where Name (name ':= x) = name
47−type Column = Named PGType
48−type Table = Named [Column]
49−type Database = Named [Table]
50−type Schema = Named [Database]
51−data Alias (obj :: k -> *) (named :: Named k) where
52− As :: KnownSymbol name => obj x -> Alias obj (name ':= x)
53− Elem
54− :: (KnownSymbol name, (name ':= x) `Elem` list ~ 'True)
55− => Alias (obj list) (name ':= x)
56−
57−type family Elem x xs where
58− x `Elem` '[] = 'False
59− x `Elem` (x ': xs) = 'True
60− x `Elem` (x' ': xs) = x `Elem` xs
61−
62−class ToOid pg where toOid :: Proxy pg -> LibPQ.Oid
63−class ToOids pgs where toOids :: Proxy pgs -> [LibPQ.Oid]
64−instance ToOids '[] where toOids _ = []
65−instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
66− toOids (_ :: Proxy (pg ': pgs)) = toOid (Proxy @pg) : toOids (Proxy @pgs)
squeel-postgresql/src/Squeel/PostgreSQL/Value.hs+49−52
@@ -15,25 +15,24 @@ module Squeel.PostgreSQL.Value where
1515
1616import Control.Arrow (left)
1717import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
18−import Data.Bits (Bits)
1918import Data.ByteString (ByteString)
20−import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
2119import Data.Int (Int16,Int32,Int64)
2220import Data.Proxy
2321import Data.Vinyl
2422import Data.Vinyl.Functor
2523import PostgreSQL.Binary.Decoder (Decoder)
26−import qualified PostgreSQL.Binary.Decoder as Decoder
2724import PostgreSQL.Binary.Encoder (Encoder)
28−import qualified PostgreSQL.Binary.Encoder as Encoder
2925import Data.Proxy (Proxy)
3026import Data.Scientific (Scientific)
3127import Data.Text (Text)
3228import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
29+import Data.UUID (UUID)
30+
31+import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
3332import qualified Data.Text as Text (pack)
3433import qualified Data.Text.Lazy as Lazy (Text)
35−import Data.UUID (UUID)
36−import Data.Word (Word16, Word32, Word64)
34+import qualified PostgreSQL.Binary.Decoder as Decoder
35+import qualified PostgreSQL.Binary.Encoder as Encoder
3736
3837import Squeel.PostgreSQL.Type
3938
@@ -42,94 +41,92 @@ decodeValue = Decoder.run . fromValue
4241
4342class FromValue (pg :: PGType) x where
4443 fromValue :: Proxy pg -> Decoder x
45−instance (Integral x, Bits x) => FromValue ('PGType "int") x where
44+instance FromValue 'PGInt2 Int16 where
45+ fromValue _ = Decoder.int
46+instance FromValue 'PGInt4 Int32 where
47+ fromValue _ = Decoder.int
48+instance FromValue 'PGInt8 Int64 where
4649 fromValue _ = Decoder.int
47−instance FromValue ('PGType "float4") Float where
50+instance FromValue 'PGFloat4 Float where
4851 fromValue _ = Decoder.float4
49−instance FromValue ('PGType "float8") Double where
52+instance FromValue 'PGFloat8 Double where
5053 fromValue _ = Decoder.float8
51−instance FromValue ('PGType "bool") Bool where
54+instance FromValue 'PGBool Bool where
5255 fromValue _ = Decoder.bool
53−instance FromValue ('PGType "bytea") ByteString where
56+instance FromValue 'PGBytea ByteString where
5457 fromValue _ = Decoder.bytea_strict
55−instance FromValue ('PGType "bytea") Lazy.ByteString where
58+instance FromValue 'PGBytea Lazy.ByteString where
5659 fromValue _ = Decoder.bytea_lazy
57−instance FromValue ('PGType "text") Text where
60+instance FromValue 'PGText Text where
5861 fromValue _ = Decoder.text_strict
59−instance FromValue ('PGType "text") Lazy.Text where
62+instance FromValue 'PGText Lazy.Text where
6063 fromValue _ = Decoder.text_lazy
61−instance FromValue ('PGType "char") Char where
64+instance FromValue ('PGChar 1) Char where
6265 fromValue _ = Decoder.char
63−instance FromValue ('PGType "numeric") Scientific where
66+instance FromValue 'PGNumeric Scientific where
6467 fromValue _ = Decoder.numeric
65−instance FromValue ('PGType "uuid") UUID where
68+instance FromValue 'PGUuid UUID where
6669 fromValue _ = Decoder.uuid
67−instance FromJSON x => FromValue ('PGType "json") x where
70+instance FromJSON x => FromValue 'PGJson x where
6871 fromValue _ = Decoder.json_bytes (left Text.pack . eitherDecodeStrict)
69−instance FromJSON x => FromValue ('PGType "jsonb") x where
72+instance FromJSON x => FromValue 'PGJsonb x where
7073 fromValue _ = Decoder.jsonb_bytes (left Text.pack . eitherDecodeStrict)
71−instance FromValue ('PGType "date") Day where
74+instance FromValue 'PGDate Day where
7275 fromValue _ = Decoder.date
73−instance FromValue ('PGType "time") TimeOfDay where
76+instance FromValue 'PGTime TimeOfDay where
7477 fromValue _ = Decoder.time_int
75−instance FromValue ('PGType "timetz") (TimeOfDay, TimeZone) where
78+instance FromValue 'PGTimeTZ (TimeOfDay, TimeZone) where
7679 fromValue _ = Decoder.timetz_int
77−instance FromValue ('PGType "timestamp") LocalTime where
80+instance FromValue 'PGTimestamp LocalTime where
7881 fromValue _ = Decoder.timestamp_int
79−instance FromValue ('PGType "timestamptz") UTCTime where
82+instance FromValue 'PGTimestampTZ UTCTime where
8083 fromValue _ = Decoder.timestamptz_int
81−instance FromValue ('PGType "interval") DiffTime where
84+instance FromValue 'PGInterval DiffTime where
8285 fromValue _ = Decoder.interval_int
8386
8487class ToValue x (pg :: PGType) where
8588 toValue :: Proxy pg -> Encoder x
86−instance ToValue Int16 ('PGType "int2") where
89+instance ToValue Int16 'PGInt2 where
8790 toValue _ = Encoder.int2_int16
88−instance ToValue Int32 ('PGType "int4") where
91+instance ToValue Int32 'PGInt4 where
8992 toValue _ = Encoder.int4_int32
90−instance ToValue Int64 ('PGType "int8") where
93+instance ToValue Int64 'PGInt8 where
9194 toValue _ = Encoder.int8_int64
92−instance ToValue Word16 ('PGType "word2") where
93− toValue _ = Encoder.int2_word16
94−instance ToValue Word32 ('PGType "word4") where
95− toValue _ = Encoder.int4_word32
96−instance ToValue Word64 ('PGType "word8") where
97− toValue _ = Encoder.int8_word64
98−instance ToValue Float ('PGType "float4") where
95+instance ToValue Float 'PGFloat4 where
9996 toValue _ = Encoder.float4
100−instance ToValue Double ('PGType "float8") where
97+instance ToValue Double 'PGFloat8 where
10198 toValue _ = Encoder.float8
102−instance ToValue Bool ('PGType "bool") where
99+instance ToValue Bool 'PGBool where
103100 toValue _ = Encoder.bool
104−instance ToValue ByteString ('PGType "bytea") where
101+instance ToValue ByteString 'PGBytea where
105102 toValue _ = Encoder.bytea_strict
106−instance ToValue Lazy.ByteString ('PGType "bytea") where
103+instance ToValue Lazy.ByteString 'PGBytea where
107104 toValue _ = Encoder.bytea_lazy
108−instance ToValue Text ('PGType "text") where
105+instance ToValue Text 'PGText where
109106 toValue _ = Encoder.text_strict
110−instance ToValue Lazy.Text ('PGType "text") where
107+instance ToValue Lazy.Text 'PGText where
111108 toValue _ = Encoder.text_lazy
112−instance ToValue Char ('PGType "char") where
109+instance ToValue Char ('PGChar 1) where
113110 toValue _ = Encoder.char
114−instance ToValue Scientific ('PGType "numeric") where
111+instance ToValue Scientific 'PGNumeric where
115112 toValue _ = Encoder.numeric
116−instance ToValue UUID ('PGType "uuid") where
113+instance ToValue UUID 'PGUuid where
117114 toValue _ = Encoder.uuid
118−instance ToJSON x => ToValue x ('PGType "json") where
115+instance ToJSON x => ToValue x 'PGJson where
119116 toValue _ = Encoder.json_bytes . Lazy.toStrict . encode
120−instance ToJSON x => ToValue x ('PGType "jsonb") where
117+instance ToJSON x => ToValue x 'PGJsonb where
121118 toValue _ = Encoder.jsonb_bytes . Lazy.toStrict . encode
122−instance ToValue Day ('PGType "date") where
119+instance ToValue Day 'PGDate where
123120 toValue _ = Encoder.date
124−instance ToValue TimeOfDay ('PGType "time") where
121+instance ToValue TimeOfDay 'PGTime where
125122 toValue _ = Encoder.time_int
126−instance ToValue (TimeOfDay, TimeZone) ('PGType "timetz") where
123+instance ToValue (TimeOfDay, TimeZone) 'PGTimeTZ where
127124 toValue _ = Encoder.timetz_int
128−instance ToValue LocalTime ('PGType "timestamp") where
125+instance ToValue LocalTime 'PGTimestamp where
129126 toValue _ = Encoder.timestamp_int
130−instance ToValue UTCTime ('PGType "timestamptz") where
127+instance ToValue UTCTime 'PGTimestampTZ where
131128 toValue _ = Encoder.timestamptz_int
132−instance ToValue DiffTime ('PGType "interval") where
129+instance ToValue DiffTime 'PGInterval where
133130 toValue _ = Encoder.interval_int
134131
135132class ToValues xs pgs where
squeel-postgresql/src/Squeel/PostgreSQL/Value2.hsdeleted−138
@@ -1,138 +0,0 @@
1−{-# LANGUAGE
2− DataKinds
3− , FlexibleInstances
4− , FunctionalDependencies
5− , KindSignatures
6− , MultiParamTypeClasses
7− , PolyKinds
8− , ScopedTypeVariables
9− , TypeApplications
10− , TypeFamilies
11− , TypeOperators
12−#-}
13−
14−module Squeel.PostgreSQL.Value2 where
15−
16−import Control.Arrow (left)
17−import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
18−import Data.ByteString (ByteString)
19−import Data.Int (Int16,Int32,Int64)
20−import Data.Proxy
21−import Data.Vinyl
22−import Data.Vinyl.Functor
23−import PostgreSQL.Binary.Decoder (Decoder)
24−import PostgreSQL.Binary.Encoder (Encoder)
25−import Data.Proxy (Proxy)
26−import Data.Scientific (Scientific)
27−import Data.Text (Text)
28−import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
29−import Data.UUID (UUID)
30−
31−import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
32−import qualified Data.Text as Text (pack)
33−import qualified Data.Text.Lazy as Lazy (Text)
34−import qualified PostgreSQL.Binary.Decoder as Decoder
35−import qualified PostgreSQL.Binary.Encoder as Encoder
36−
37−import Squeel.PostgreSQL.Type2
38−
39−decodeValue :: FromValue pg x => Proxy pg -> ByteString -> Either Text x
40−decodeValue = Decoder.run . fromValue
41−
42−class FromValue (pg :: PGType) x where
43− fromValue :: Proxy pg -> Decoder x
44−instance FromValue 'PGInt2 Int16 where
45− fromValue _ = Decoder.int
46−instance FromValue 'PGInt4 Int32 where
47− fromValue _ = Decoder.int
48−instance FromValue 'PGInt8 Int64 where
49− fromValue _ = Decoder.int
50−instance FromValue 'PGFloat4 Float where
51− fromValue _ = Decoder.float4
52−instance FromValue 'PGFloat8 Double where
53− fromValue _ = Decoder.float8
54−instance FromValue 'PGBool Bool where
55− fromValue _ = Decoder.bool
56−instance FromValue 'PGBytea ByteString where
57− fromValue _ = Decoder.bytea_strict
58−instance FromValue 'PGBytea Lazy.ByteString where
59− fromValue _ = Decoder.bytea_lazy
60−instance FromValue 'PGText Text where
61− fromValue _ = Decoder.text_strict
62−instance FromValue 'PGText Lazy.Text where
63− fromValue _ = Decoder.text_lazy
64−instance FromValue ('PGChar 1) Char where
65− fromValue _ = Decoder.char
66−instance FromValue 'PGNumeric Scientific where
67− fromValue _ = Decoder.numeric
68−instance FromValue 'PGUuid UUID where
69− fromValue _ = Decoder.uuid
70−instance FromJSON x => FromValue 'PGJson x where
71− fromValue _ = Decoder.json_bytes (left Text.pack . eitherDecodeStrict)
72−instance FromJSON x => FromValue 'PGJsonb x where
73− fromValue _ = Decoder.jsonb_bytes (left Text.pack . eitherDecodeStrict)
74−instance FromValue 'PGDate Day where
75− fromValue _ = Decoder.date
76−instance FromValue 'PGTime TimeOfDay where
77− fromValue _ = Decoder.time_int
78−instance FromValue 'PGTimeTZ (TimeOfDay, TimeZone) where
79− fromValue _ = Decoder.timetz_int
80−instance FromValue 'PGTimestamp LocalTime where
81− fromValue _ = Decoder.timestamp_int
82−instance FromValue 'PGTimestampTZ UTCTime where
83− fromValue _ = Decoder.timestamptz_int
84−instance FromValue 'PGInterval DiffTime where
85− fromValue _ = Decoder.interval_int
86−
87−class ToValue x (pg :: PGType) where
88− toValue :: Proxy pg -> Encoder x
89−instance ToValue Int16 'PGInt2 where
90− toValue _ = Encoder.int2_int16
91−instance ToValue Int32 'PGInt4 where
92− toValue _ = Encoder.int4_int32
93−instance ToValue Int64 'PGInt8 where
94− toValue _ = Encoder.int8_int64
95−instance ToValue Float 'PGFloat4 where
96− toValue _ = Encoder.float4
97−instance ToValue Double 'PGFloat8 where
98− toValue _ = Encoder.float8
99−instance ToValue Bool 'PGBool where
100− toValue _ = Encoder.bool
101−instance ToValue ByteString 'PGBytea where
102− toValue _ = Encoder.bytea_strict
103−instance ToValue Lazy.ByteString 'PGBytea where
104− toValue _ = Encoder.bytea_lazy
105−instance ToValue Text 'PGText where
106− toValue _ = Encoder.text_strict
107−instance ToValue Lazy.Text 'PGText where
108− toValue _ = Encoder.text_lazy
109−instance ToValue Char ('PGChar 1) where
110− toValue _ = Encoder.char
111−instance ToValue Scientific 'PGNumeric where
112− toValue _ = Encoder.numeric
113−instance ToValue UUID 'PGUuid where
114− toValue _ = Encoder.uuid
115−instance ToJSON x => ToValue x 'PGJson where
116− toValue _ = Encoder.json_bytes . Lazy.toStrict . encode
117−instance ToJSON x => ToValue x 'PGJsonb where
118− toValue _ = Encoder.jsonb_bytes . Lazy.toStrict . encode
119−instance ToValue Day 'PGDate where
120− toValue _ = Encoder.date
121−instance ToValue TimeOfDay 'PGTime where
122− toValue _ = Encoder.time_int
123−instance ToValue (TimeOfDay, TimeZone) 'PGTimeTZ where
124− toValue _ = Encoder.timetz_int
125−instance ToValue LocalTime 'PGTimestamp where
126− toValue _ = Encoder.timestamp_int
127−instance ToValue UTCTime 'PGTimestampTZ where
128− toValue _ = Encoder.timestamptz_int
129−instance ToValue DiffTime 'PGInterval where
130− toValue _ = Encoder.interval_int
131−
132−class ToValues xs pgs where
133− toValues :: Proxy pgs -> Rec Identity xs -> [ByteString]
134−instance ToValues '[] '[] where toValues _ _ = []
135−instance (ToValue x pg, ToValues xs pgs)
136− => ToValues (x ': xs) (pg ': pgs) where
137− toValues (_ :: Proxy (pg ': pgs)) (Identity x :& xs) =
138− Encoder.run (toValue (Proxy @pg)) x : toValues (Proxy @pgs) xs