git.iko.soy/squeal
on dev help sign in
Merge pull request #3 from echatav/insert

Insert

commit891ab25de68ff5ec382332bdb1f618db2b9e625e authorEitan Chatav <eitan.chatav@gmail.com> dateSun 23 Apr 2017, 10:29 (10 years ago) parent9c9395f6253103
2 files changed+62−13
compare with dev
unifiedsplit
squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+48−2 squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs+14−11
squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+48−2
@@ -21,9 +21,11 @@ import Data.Monoid
2121import Data.Proxy
2222import Data.String
2323import Data.Vinyl
24+import Data.Vinyl.Functor
2425import GHC.OverloadedLabels
2526import GHC.TypeLits
2627
28+import qualified Data.ByteString as ByteString
2729import qualified Data.ByteString.Char8 as Char8
2830
2931import Squeel.PostgreSQL.Type
@@ -33,7 +35,7 @@ class HasField label xs x where
3335instance {-# OVERLAPPING #-} KnownSymbol label
3436 => HasField label ('(label, x) ': xs) x where
3537 fieldName _ _ _ = Char8.pack (symbolVal (Proxy @label))
36−instance HasField label xs y
38+instance {-# OVERLAPPABLE #-} HasField label xs y
3739 => HasField label (x ': xs) y where
3840 fieldName _ _ _ = fieldName (Proxy @label) (Proxy @xs) (Proxy @y)
3941
@@ -45,6 +47,9 @@ instance IsLabel label (obj x)
4547 => IsLabel label (Aliased obj '(label, x)) where
4648 fromLabel p = fromLabel p `As` fromLabel p
4749
50+aliasName :: forall label. KnownSymbol label => Alias label -> ByteString
51+aliasName _ = Char8.pack (symbolVal (Proxy @label))
52+
4853alias :: Aliased obj '(label, x) -> Alias label
4954alias _ = Alias
5055
@@ -59,6 +64,23 @@ renderAliased
5964renderAliased render (obj `As` label) =
6065 render obj <> " AS " <> Char8.pack (symbolVal label)
6166
67+class UnzipAliased (xs :: [(Symbol,k)]) where
68+ type Unaliased xs :: [k]
69+ unzipAliased
70+ :: Rec (Aliased obj) xs
71+ -> ([ByteString], Rec obj (Unaliased xs))
72+instance UnzipAliased '[] where
73+ type Unaliased '[] = '[]
74+ unzipAliased _ = ([], RNil)
75+instance (KnownSymbol label, UnzipAliased xs)
76+ => UnzipAliased ( '(label, x) ': xs) where
77+ type Unaliased ( '(label, x) ': xs) = x ': Unaliased xs
78+ unzipAliased (x :& xs) =
79+ let
80+ (labels,values) = unzipAliased xs
81+ in
82+ (aliasName (alias x) : labels, unalias x :& values)
83+
6284class AllAliased xs where
6385 renderAllAliased
6486 :: (forall x. obj x -> ByteString)
@@ -232,9 +254,33 @@ subselect selection = Relation
232254 , offsetting = Nothing
233255 }
234256
257+newtype Insertion ps xss xs = UnsafeInsertion
258+ {renderInsertion :: ByteString }
259+
260+into
261+ :: forall label xss xs ps
262+ . (HasField label xss xs, UnzipAliased xs)
263+ => Proxy label
264+ -> Rec (Aliased (Expression ps '[])) xs
265+ -> Insertion ps xss xs
266+into table values = UnsafeInsertion $ "INTO "
267+ <> fieldName table (Proxy @xss) (Proxy @xs)
268+ <> " (" <> ByteString.intercalate ", " names
269+ <> ") VALUES ("
270+ <> ByteString.intercalate ", "
271+ (recordToList (rmap (Const . renderExpression) exprs))
272+ <> ")"
273+ where
274+ (names,exprs) = unzipAliased values
275+
235276newtype Query ps xss yss zs = UnsafeQuery { renderQuery :: ByteString }
236277newtype PreparedQuery ps xss yss zs =
237278 UnsafePreparedQuery { renderPreparedQuery :: ByteString }
238279
239280select :: Selection ps xss ys -> Query ps xss xss ys
240−select selection = UnsafeQuery $ "SELECT " <> renderSelection selection <> ";"
281+select selection = UnsafeQuery $
282+ "SELECT " <> renderSelection selection <> ";"
283+
284+insert :: Insertion ps xss xs -> Query ps xss xss '[]
285+insert insertion = UnsafeQuery $
286+ "INSERT " <> renderInsertion insertion <> ";"
squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs+14−11
@@ -2,11 +2,13 @@
22 DataKinds
33 , OverloadedLabels
44 , OverloadedStrings
5+ , TypeApplications
56#-}
67
78module Squeel.PostgreSQL.QuerySpec where
89
910import Data.Boolean
11+import Data.Proxy
1012import Data.Vinyl
1113import Test.Hspec
1214
@@ -47,21 +49,22 @@ spec = do
4749 renderQuery (select (star `from` (table1 `offset` 1 `offset` 2)))
4850 `shouldBe`
4951 "SELECT * FROM table1 OFFSET 1+2;"
52+ it "correctly render simple INSERTs" $ do
53+ renderQuery (insert insertion)
54+ `shouldBe`
55+ "INSERT INTO table1 (col1, col2) VALUES (2, 4);"
5056
57+type Columns = '[ '("col1", 'PGInt4), '("col2", 'PGInt4)]
58+type Tables = '[ '("table1", Columns)]
5159
52−type Columns =
53− '[ '("col1", 'PGInt4)
54− , '("col2", 'PGInt4)
55− ]
56−
57−sumAndCol1 :: Projection '[] Columns
58− '[ '("sum", 'PGInt4)
59− , '("col1", 'PGInt4)
60− ]
60+sumAndCol1 :: Projection '[] Columns '[ '("sum", 'PGInt4), '("col1", 'PGInt4)]
6161sumAndCol1 = project ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
6262
63−table1 :: Relation '[] '[ '("table1", Columns)] Columns
63+table1 :: Relation '[] Tables Columns
6464table1 = #table1
6565
66−parameterizedTable1 :: Relation '[ 'PGInt8] '[ '("table1", Columns)] Columns
66+parameterizedTable1 :: Relation '[ 'PGInt8] Tables Columns
6767parameterizedTable1 = #table1
68+
69+insertion :: Insertion '[] Tables Columns
70+insertion = into (Proxy @"table1") (2 `As` #col1 :& 4 `As` #col2 :& RNil)