git.iko.soy/squeal
on dev help sign in
FromColumnValue
b674ad8Eitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/Binary2.hs+36−11
compare with dev
unifiedsplit
@@ -4,9 +4,12 @@
4 , FlexibleContexts
4 , FlexibleContexts
5 , FlexibleInstances
5 , FlexibleInstances
6 , GADTs
6 , GADTs
7+ , LambdaCase
7 , KindSignatures
8 , KindSignatures
8 , MultiParamTypeClasses
9 , MultiParamTypeClasses
9 , ScopedTypeVariables
10 , ScopedTypeVariables
11+ , TypeApplications
12+ , TypeOperators
10#-}
13#-}
11
14
12module Squeel.PostgreSQL.Binary2 where
15module Squeel.PostgreSQL.Binary2 where
@@ -22,7 +25,7 @@ import Generics.SOP
22import Network.IP.Addr
25import Network.IP.Addr
23
26
24import qualified Data.ByteString.Lazy as Lazy
27import qualified Data.ByteString.Lazy as Lazy
25−import qualified Data.ByteString as Strict
28+import qualified Data.ByteString as Strict hiding (unpack)
26import qualified Data.Text.Lazy as Lazy
29import qualified Data.Text.Lazy as Lazy
27import qualified Data.Text as Strict
30import qualified Data.Text as Strict
28import qualified PostgreSQL.Binary.Decoding as Decoding
31import qualified PostgreSQL.Binary.Decoding as Decoding
@@ -65,11 +68,11 @@ instance ToParam Value 'PGJsonb where toParam = K . Encoding.jsonb_ast
65class ToColumnParam x (ty :: ColumnType) where
68class ToColumnParam x (ty :: ColumnType) where
66 toColumnParam :: x -> K (Maybe Encoding.Encoding) ty
69 toColumnParam :: x -> K (Maybe Encoding.Encoding) ty
67instance ToParam x pg => ToColumnParam x ('Required ('NotNull pg)) where
70instance ToParam x pg => ToColumnParam x ('Required ('NotNull pg)) where
68− toColumnParam = K . Just . unK . (toParam :: x -> K Encoding.Encoding pg)
71+ toColumnParam = K . Just . unK . toParam @x @pg
69instance ToParam x pg => ToColumnParam (Maybe x) ('Required ('Null pg)) where
72instance ToParam x pg => ToColumnParam (Maybe x) ('Required ('Null pg)) where
70− toColumnParam = K . fmap (unK . (toParam :: x -> K Encoding.Encoding pg))
73+ toColumnParam = K . fmap (unK . toParam @x @pg)
71instance ToParam x pg => ToColumnParam (Maybe x) ('Optional (nullity pg)) where
74instance ToParam x pg => ToColumnParam (Maybe x) ('Optional (nullity pg)) where
72− toColumnParam = K . fmap (unK . (toParam :: x -> K Encoding.Encoding pg))
75+ toColumnParam = K . fmap (unK . toParam @x @pg)
73
76
74class ToParams x (tys :: [ColumnType]) where
77class ToParams x (tys :: [ColumnType]) where
75 toParams :: x -> NP (K (Maybe Encoding.Encoding)) tys
78 toParams :: x -> NP (K (Maybe Encoding.Encoding)) tys
@@ -77,7 +80,7 @@ class ToParams x (tys :: [ColumnType]) where
77 :: (IsProductType x xs, AllZip ToColumnParam xs tys)
80 :: (IsProductType x xs, AllZip ToColumnParam xs tys)
78 => x -> NP (K (Maybe Encoding.Encoding)) tys
81 => x -> NP (K (Maybe Encoding.Encoding)) tys
79 toParams
82 toParams
80− = htrans (Proxy :: Proxy ToColumnParam) (toColumnParam . unI)
83+ = htrans (Proxy @ToColumnParam) (toColumnParam . unI)
81 . unZ . unSOP . from
84 . unZ . unSOP . from
82
85
83class FromValue (pg :: PGType) y where
86class FromValue (pg :: PGType) y where
@@ -114,11 +117,33 @@ instance FromValue 'PGInterval DiffTime where
114instance FromValue 'PGJson Value where fromValue _ = Decoding.json_ast
117instance FromValue 'PGJson Value where fromValue _ = Decoding.json_ast
115instance FromValue 'PGJsonb Value where fromValue _ = Decoding.jsonb_ast
118instance FromValue 'PGJsonb Value where fromValue _ = Decoding.jsonb_ast
116
119
120+class FromColumnValue (colty :: (Symbol,ColumnType)) y where
121+ fromColumnValue :: K (Maybe Strict.ByteString) colty -> y
122+instance FromValue pg y
123+ => FromColumnValue (column ::: ('Required ('NotNull pg))) y where
124+ fromColumnValue = \case
125+ K Nothing -> error "fromColumnValue: saw NULL when expecting NOT NULL"
126+ (K (Just bytes)) ->
127+ let
128+ errOrValue =
129+ Decoding.valueParser (fromValue @pg @y Proxy) bytes
130+ err str = error $ "fromColumnValue: " ++ Strict.unpack str
131+ in
132+ either err id errOrValue
133+instance FromValue pg y
134+ => FromColumnValue (column ::: ('Required ('Null pg))) (Maybe y) where
135+ fromColumnValue (K nullOrBytes)
136+ = either err id
137+ . Decoding.valueParser (fromValue @pg @y Proxy)
138+ <$> nullOrBytes
139+ where
140+ err str = error $ "fromColumnValue: " ++ Strict.unpack str
141+
117−class FromRow pgs y where
142+class FromRow (columns :: [(Symbol,ColumnType)]) y where
118− fromRow :: NP proxy pgs -> Decoding.Value y
143+ fromRow :: NP (K (Maybe Strict.ByteString)) columns -> y
119 default fromRow
144 default fromRow
120− :: (IsProductType y ys, AllZip FromValue pgs ys)
145+ :: (IsProductType y ys, AllZip FromColumnValue columns ys)
121− => NP proxy pgs -> Decoding.Value y
146+ => NP (K (Maybe Strict.ByteString)) columns -> y
122 fromRow
147 fromRow
123− = fmap to . hsequence
148+ = to . SOP . Z
124− . htrans (Proxy :: Proxy FromValue) fromValue . SOP . Z
149+ . htrans (Proxy :: Proxy FromColumnValue) (I . fromColumnValue)