git.iko.soy/squeal
on dev help sign in
use generics for reading and showing enums
0df15eaEitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+29−14
compare with dev
unifiedsplit
@@ -53,7 +53,6 @@ import Data.Word
53import Generics.SOP
53import Generics.SOP
54import GHC.TypeLits
54import GHC.TypeLits
55import Network.IP.Addr
55import Network.IP.Addr
56−import Text.Read (readMaybe)
57
56
58import qualified Data.ByteString.Lazy as Lazy
57import qualified Data.ByteString.Lazy as Lazy
59import qualified Data.ByteString as Strict hiding (pack, unpack)
58import qualified Data.ByteString as Strict hiding (pack, unpack)
@@ -126,18 +125,17 @@ instance
126 ) => ToParam x ('PGenum labels) where
125 ) => ToParam x ('PGenum labels) where
127 toParam =
126 toParam =
128 let
127 let
129− gcons :: forall y. (HasDatatypeInfo y, Generic y) => y -> String
130− gcons = gconstructor (constructorInfo (datatypeInfo (Proxy @y))) . from
131−
132− gconstructor :: NP ConstructorInfo xs -> SOP I xs -> String
128+ gshowConstructor :: NP ConstructorInfo xss -> SOP I xss -> String
133− gconstructor Nil _ = ""
129+ gshowConstructor Nil _ = ""
134− gconstructor (Constructor name :* _) (SOP (Z _)) = name
130+ gshowConstructor (constructor :* _) (SOP (Z _)) =
135− gconstructor (Infix name _ _ :* _) (SOP (Z _)) = name
131+ constructorName constructor
136− gconstructor (Record name _ :* _) (SOP (Z _)) = name
137− gconstructor (_ :* constructors) (SOP (S xs)) =
132+ gshowConstructor (_ :* constructors) (SOP (S xs)) =
138− gconstructor constructors (SOP xs)
133+ gshowConstructor constructors (SOP xs)
139 in
134 in
140− K . Encoding.text_strict . Strict.pack . gcons
135+ K . Encoding.text_strict
136+ . Strict.pack
137+ . gshowConstructor (constructorInfo (datatypeInfo (Proxy @x)))
138+ . from
141instance
139instance
142 ( SListI fields
140 ( SListI fields
143 , MapMaybes xs
141 , MapMaybes xs
@@ -278,10 +276,27 @@ instance FromValue pg y => FromValue ('PGfixarray n pg) (Vector (Maybe y)) where
278 (Decoding.nullableValueArray (fromValue (Proxy @pg))))
276 (Decoding.nullableValueArray (fromValue (Proxy @pg))))
279instance
277instance
280 ( IsEnumType y
278 ( IsEnumType y
281− , Read y
279+ , HasDatatypeInfo y
282 , SameLabels (DatatypeInfoOf y) labels
280 , SameLabels (DatatypeInfoOf y) labels
283 ) => FromValue ('PGenum labels) y where
281 ) => FromValue ('PGenum labels) y where
282+ fromValue _ =
283+ let
284+ greadConstructor
285+ :: All ((~) '[]) xss
286+ => NP ConstructorInfo xss
287+ -> String
288+ -> Maybe (SOP I xss)
289+ greadConstructor Nil _ = Nothing
290+ greadConstructor (constructor :* constructors) name =
291+ if name == constructorName constructor
292+ then Just (SOP (Z Nil))
293+ else SOP . S . unSOP <$> greadConstructor constructors name
294+ in
284− fromValue _ = Decoding.enum (readMaybe . Strict.unpack)
295+ Decoding.enum
296+ $ fmap to
297+ . greadConstructor (constructorInfo (datatypeInfo (Proxy @y)))
298+ . Strict.unpack
299+
285instance
300instance
286 ( SListI fields
301 ( SListI fields
287 , MapMaybes ys
302 , MapMaybes ys