@@ -4,9 +4,12 @@
44 , FlexibleContexts
55 , FlexibleInstances
66 , GADTs
7+ , LambdaCase
78 , KindSignatures
89 , MultiParamTypeClasses
910 , ScopedTypeVariables
11+ , TypeApplications
12+ , TypeOperators
1013#-}
1114
1215module Squeel.PostgreSQL.Binary2 where
@@ -22,7 +25,7 @@ import Generics.SOP
2225import Network.IP.Addr
2326
2427import qualified Data.ByteString.Lazy as Lazy
25−import qualified Data.ByteString as Strict
28+import qualified Data.ByteString as Strict hiding (unpack)
2629import qualified Data.Text.Lazy as Lazy
2730import qualified Data.Text as Strict
2831import qualified PostgreSQL.Binary.Decoding as Decoding
@@ -65,11 +68,11 @@ instance ToParam Value 'PGJsonb where toParam = K . Encoding.jsonb_ast
6568class ToColumnParam x (ty :: ColumnType) where
6669 toColumnParam :: x -> K (Maybe Encoding.Encoding) ty
6770instance 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
6972instance 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)
7174instance 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)
7376
7477class ToParams x (tys :: [ColumnType]) where
7578 toParams :: x -> NP (K (Maybe Encoding.Encoding)) tys
@@ -77,7 +80,7 @@ class ToParams x (tys :: [ColumnType]) where
7780 :: (IsProductType x xs, AllZip ToColumnParam xs tys)
7881 => x -> NP (K (Maybe Encoding.Encoding)) tys
7982 toParams
80− = htrans (Proxy :: Proxy ToColumnParam) (toColumnParam . unI)
83+ = htrans (Proxy @ToColumnParam) (toColumnParam . unI)
8184 . unZ . unSOP . from
8285
8386class FromValue (pg :: PGType) y where
@@ -114,11 +117,33 @@ instance FromValue 'PGInterval DiffTime where
114117instance FromValue 'PGJson Value where fromValue _ = Decoding.json_ast
115118instance FromValue 'PGJsonb Value where fromValue _ = Decoding.jsonb_ast
116119
117−class FromRow pgs y where
118− fromRow :: NP proxy pgs -> Decoding.Value y
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+
142+class FromRow (columns :: [(Symbol,ColumnType)]) y where
143+ fromRow :: NP (K (Maybe Strict.ByteString)) columns -> y
119144 default fromRow
120− :: (IsProductType y ys, AllZip FromValue pgs ys)
121− => NP proxy pgs -> Decoding.Value y
145+ :: (IsProductType y ys, AllZip FromColumnValue columns ys)
146+ => NP (K (Maybe Strict.ByteString)) columns -> y
122147 fromRow
123− = fmap to . hsequence
124− . htrans (Proxy :: Proxy FromValue) fromValue . SOP . Z
148+ = to . SOP . Z
149+ . htrans (Proxy :: Proxy FromColumnValue) (I . fromColumnValue)