git.iko.soy/squeal
on dev help sign in
enforce same fields
commitbed538dc24fc6a74fc11045666eebc34499199a1 authorEitan Chatav <eitan.chatav@gmail.com> dateMon 14 Aug 2017, 11:38 (9 years ago) parentfb7a31c
2 files changed+42−16
compare with dev
unifiedsplit
squeel-postgresql/exe/Example.hs+13−12 squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+29−4
squeel-postgresql/exe/Example.hs+13−12
@@ -23,6 +23,19 @@ import Squeel.PostgreSQL
2323import qualified Data.ByteString.Char8 as Char8
2424import qualified GHC.Generics as GHC
2525
26+type Schema =
27+ '[ "students" ::: '["name" ::: 'Required ('NotNull 'PGtext)]
28+ , "table1" :::
29+ '[ "col1" ::: 'Required ('NotNull 'PGint4)
30+ , "col2" ::: 'Required ('NotNull 'PGint4)
31+ ]
32+ ]
33+
34+data Table1Row = Table1Row { col1 :: Int32, col2 :: Int32 }
35+ deriving (Show, GHC.Generic)
36+instance Generic Table1Row
37+instance HasDatatypeInfo Table1Row
38+
2639main :: IO ()
2740main = do
2841 Char8.putStrLn "squeel"
@@ -72,15 +85,3 @@ main = do
7285 connection3 <- runPQ (connection2 :: Connection Schema) $ pqExec $
7386 dropTable #table1 >>> dropTable #students
7487 finish (connection3 :: Connection '[])
75−
76−data Table1Row = Table1Row { col1 :: Int32, col2 :: Int32 }
77− deriving (Show, GHC.Generic)
78−instance Generic Table1Row
79−
80−type Schema =
81− '[ "students" ::: '["name" ::: 'Required ('NotNull 'PGtext)]
82− , "table1" :::
83− '[ "col1" ::: 'Required ('NotNull 'PGint4)
84− , "col2" ::: 'Required ('NotNull 'PGint4)
85− ]
86− ]
squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+29−4
@@ -1,6 +1,10 @@
11{-# LANGUAGE
22 DataKinds
33 , DefaultSignatures
4+ , DeriveFoldable
5+ , DeriveFunctor
6+ , DeriveGeneric
7+ , DeriveTraversable
48 , FlexibleContexts
59 , FlexibleInstances
610 , GADTs
@@ -9,6 +13,7 @@
913 , MultiParamTypeClasses
1014 , ScopedTypeVariables
1115 , TypeApplications
16+ , TypeFamilies
1217 , TypeOperators
1318 , UndecidableInstances
1419#-}
@@ -29,6 +34,8 @@ import qualified Data.ByteString.Lazy as Lazy
2934import qualified Data.ByteString as Strict hiding (unpack)
3035import qualified Data.Text.Lazy as Lazy
3136import qualified Data.Text as Strict
37+import qualified Generics.SOP.Type.Metadata as Type
38+import qualified GHC.Generics as GHC
3239import qualified PostgreSQL.Binary.Decoding as Decoding
3340import qualified PostgreSQL.Binary.Encoding as Encoding
3441
@@ -77,8 +84,6 @@ instance ToParam x pg => ToColumnParam (Maybe x) ('Optional (nullity pg)) where
7784
7885class SListI tys => ToParams x (tys :: [ColumnType]) where
7986 toParams :: x -> NP (K (Maybe Strict.ByteString)) tys
80−instance ToColumnParam x ty => ToParams x '[ty] where
81− toParams x = toColumnParam x :* Nil
8287instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)
8388 => ToParams x tys where
8489 toParams
@@ -143,11 +148,31 @@ instance FromValue pg y
143148
144149class SListI columns => FromRow (columns :: [(Symbol,ColumnType)]) y where
145150 fromRow :: NP (K (Maybe Strict.ByteString)) columns -> y
146−instance FromColumnValue ty y => FromRow '[ty] y where
147− fromRow (y :* Nil) = fromColumnValue y
148151instance
149152 ( SListI columns, IsProductType y ys
150153 , AllZip FromColumnValue columns ys
154+ , HasDatatypeInfo y
155+ , SameFields (DatatypeInfoOf y) columns
151156 ) => FromRow columns y where
152157 fromRow
153158 = to . SOP . Z . htrans (Proxy @FromColumnValue) (I . fromColumnValue)
159+
160+class SameField
161+ (fieldInfo :: Type.FieldInfo) (columnty :: (Symbol,ColumnType)) where
162+instance field ~ column => SameField ('Type.FieldInfo field) (column ::: ty)
163+
164+type family SameFields
165+ (datatypeInfo :: Type.DatatypeInfo) (columns :: [(Symbol,ColumnType)]) where
166+ SameFields
167+ ('Type.ADT _module _datatype '[ 'Type.Record _constructor fields])
168+ columns
169+ = AllZip SameField fields columns
170+ SameFields
171+ ('Type.Newtype _module _datatype ('Type.Record _constructor '[field]))
172+ '[column]
173+ = SameField field column
174+
175+newtype Only x = Only { only :: x }
176+ deriving (Functor,Foldable,Traversable,Eq,Ord,Read,Show,GHC.Generic)
177+instance Generic (Only x)
178+instance HasDatatypeInfo (Only x)