@@ -1 +1,121 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , FlexibleInstances
4+ , KindSignatures
5+ , MultiParamTypeClasses
6+#-}
7+
18module Squeel.PostgreSQL.Value where
9+
10+import Control.Arrow (left)
11+import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
12+import Data.Bits (Bits)
13+import Data.ByteString (ByteString)
14+import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
15+import Data.Int (Int16,Int32,Int64)
16+import PostgreSQL.Binary.Decoder (Decoder)
17+import PostgreSQL.Binary.Encoder (Encoder)
18+import qualified PostgreSQL.Binary.Decoder as Decoder
19+import qualified PostgreSQL.Binary.Encoder as Encoder
20+import Data.Proxy (Proxy)
21+import Data.Scientific (Scientific)
22+import Data.Text (Text)
23+import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
24+import qualified Data.Text as Text (pack)
25+import qualified Data.Text.Lazy as Lazy (Text)
26+import Data.UUID (UUID)
27+import Data.Word (Word16, Word32, Word64)
28+
29+import Squeel.PostgreSQL.Type
30+
31+class FromValue (pg :: PGType) x where
32+ fromValue :: Proxy pg -> Decoder x
33+instance (Integral x, Bits x) => FromValue ('PGType "int") x where
34+ fromValue _ = Decoder.int
35+instance FromValue ('PGType "float4") Float where
36+ fromValue _ = Decoder.float4
37+instance FromValue ('PGType "float8") Double where
38+ fromValue _ = Decoder.float8
39+instance FromValue ('PGType "bool") Bool where
40+ fromValue _ = Decoder.bool
41+instance FromValue ('PGType "bytea") ByteString where
42+ fromValue _ = Decoder.bytea_strict
43+instance FromValue ('PGType "bytea") Lazy.ByteString where
44+ fromValue _ = Decoder.bytea_lazy
45+instance FromValue ('PGType "text") Text where
46+ fromValue _ = Decoder.text_strict
47+instance FromValue ('PGType "text") Lazy.Text where
48+ fromValue _ = Decoder.text_lazy
49+instance FromValue ('PGType "char") Char where
50+ fromValue _ = Decoder.char
51+instance FromValue ('PGType "numeric") Scientific where
52+ fromValue _ = Decoder.numeric
53+instance FromValue ('PGType "uuid") UUID where
54+ fromValue _ = Decoder.uuid
55+instance FromJSON x => FromValue ('PGType "json") x where
56+ fromValue _ = Decoder.json_bytes (left Text.pack . eitherDecodeStrict)
57+instance FromJSON x => FromValue ('PGType "jsonb") x where
58+ fromValue _ = Decoder.jsonb_bytes (left Text.pack . eitherDecodeStrict)
59+instance FromValue ('PGType "date") Day where
60+ fromValue _ = Decoder.date
61+instance FromValue ('PGType "time") TimeOfDay where
62+ fromValue _ = Decoder.time_int
63+instance FromValue ('PGType "timetz") (TimeOfDay, TimeZone) where
64+ fromValue _ = Decoder.timetz_int
65+instance FromValue ('PGType "timestamp") LocalTime where
66+ fromValue _ = Decoder.timestamp_int
67+instance FromValue ('PGType "timestamptz") UTCTime where
68+ fromValue _ = Decoder.timestamptz_int
69+instance FromValue ('PGType "interval") DiffTime where
70+ fromValue _ = Decoder.interval_int
71+
72+class ToValue (pg :: PGType) x where
73+ toValue :: Proxy pg -> Encoder x
74+instance ToValue ('PGType "int2") Int16 where
75+ toValue _ = Encoder.int2_int16
76+instance ToValue ('PGType "int4") Int32 where
77+ toValue _ = Encoder.int4_int32
78+instance ToValue ('PGType "int8") Int64 where
79+ toValue _ = Encoder.int8_int64
80+instance ToValue ('PGType "word2") Word16 where
81+ toValue _ = Encoder.int2_word16
82+instance ToValue ('PGType "word4") Word32 where
83+ toValue _ = Encoder.int4_word32
84+instance ToValue ('PGType "word8") Word64 where
85+ toValue _ = Encoder.int8_word64
86+instance ToValue ('PGType "float4") Float where
87+ toValue _ = Encoder.float4
88+instance ToValue ('PGType "float8") Double where
89+ toValue _ = Encoder.float8
90+instance ToValue ('PGType "bool") Bool where
91+ toValue _ = Encoder.bool
92+instance ToValue ('PGType "bytea") ByteString where
93+ toValue _ = Encoder.bytea_strict
94+instance ToValue ('PGType "bytea") Lazy.ByteString where
95+ toValue _ = Encoder.bytea_lazy
96+instance ToValue ('PGType "text") Text where
97+ toValue _ = Encoder.text_strict
98+instance ToValue ('PGType "text") Lazy.Text where
99+ toValue _ = Encoder.text_lazy
100+instance ToValue ('PGType "char") Char where
101+ toValue _ = Encoder.char
102+instance ToValue ('PGType "numeric") Scientific where
103+ toValue _ = Encoder.numeric
104+instance ToValue ('PGType "uuid") UUID where
105+ toValue _ = Encoder.uuid
106+instance ToJSON x => ToValue ('PGType "json") x where
107+ toValue _ = Encoder.json_bytes . Lazy.toStrict . encode
108+instance ToJSON x => ToValue ('PGType "jsonb") x where
109+ toValue _ = Encoder.jsonb_bytes . Lazy.toStrict . encode
110+instance ToValue ('PGType "date") Day where
111+ toValue _ = Encoder.date
112+instance ToValue ('PGType "time") TimeOfDay where
113+ toValue _ = Encoder.time_int
114+instance ToValue ('PGType "timetz") (TimeOfDay, TimeZone) where
115+ toValue _ = Encoder.timetz_int
116+instance ToValue ('PGType "timestamp") LocalTime where
117+ toValue _ = Encoder.timestamp_int
118+instance ToValue ('PGType "timestamptz") UTCTime where
119+ toValue _ = Encoder.timestamptz_int
120+instance ToValue ('PGType "interval") DiffTime where
121+ toValue _ = Encoder.interval_int