efdb2eb · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

replace vinyl with generics-sop

efdb2ebEitan Chatav9 years ago

squeel-postgresql/exe/Example.hs+7−7

compare with dev

unifiedsplit

@@ -13,7 +13,7 @@ import Control.Monad.Base

13import Data.Function ((&))

14import Data.Int

15import Data.Monoid

16−import Data.Vinyl

16+import Generics.SOP

17import Squeel.PostgreSQL

19import qualified Data.ByteString.Char8 as Char8

@@ -29,18 +29,18 @@ main = do

29 connection1 <- flip execPQ connection0 $ pqExec $

30 createTable #students

31 ( (text & notNull) `As` #name

32− :& RNil )

32+ :* Nil )

33 >>>

34 createTable #table1

35 ( (int4 & notNull) `As` #col1

36− :& (int4 & notNull) `As` #col2

36+ :* (int4 & notNull) `As` #col2

37− :& RNil )

37+ :* Nil )

38 connection2 <- flip execPQ connection1 $ do

39 _insertTable1Result <- pqExec $

40− insertInto #table1 ( 1 `As` #col1 :& 2 `As` #col2 :& RNil )

40+ insertInto #table1 ( 1 `As` #col1 :* 2 `As` #col2 :* Nil )

41 >>>

42− insertInto #table1 ( 3 `As` #col1 :& 4 `As` #col2 :& RNil )

42+ insertInto #table1 ( 3 `As` #col1 :* 4 `As` #col2 :* Nil )

43− Just selectTable1Result <- flip pqExecParams RNil $

43+ Just selectTable1Result <- flip pqExecParams Nil $

44 (select $ starFrom #table1 :: Statement '[] Columns Tables Tables)

45 Just (Right value00) <- getvalue selectTable1Result (RowNumber 0) colNum0

46 Just (Right value01) <- getvalue selectTable1Result (RowNumber 0) colNum1

squeel-postgresql/squeel-postgresql.cabal+3−3

@@ -25,6 +25,7 @@ library

25 , base

26 , Boolean

27 , bytestring

28+ , generics-sop

28 , lifted-base

29 , lifted-base

29 , monad-control

30 , monad-control

30 , mtl

31 , mtl

@@ -35,7 +36,6 @@ library

35 , time

36 , time

36 , transformers-base

37 , transformers-base

37 , uuid

38 , uuid

38− , vinyl

40test-suite squeel-postgresql-test

41 default-language: Haskell2010

@@ -49,9 +49,9 @@ test-suite squeel-postgresql-test

49 build-depends:

50 base

51 , Boolean

52+ , generics-sop

52 , hspec

53 , hspec

53 , squeel-postgresql

54 , squeel-postgresql

54− , vinyl

56executable squeel-postgresql-example

57 default-language: Haskell2010

@@ -61,9 +61,9 @@ executable squeel-postgresql-example

61 build-depends:

62 base

63 , bytestring

64+ , generics-sop

64 , squeel-postgresql

65 , squeel-postgresql

65 , transformers-base

66 , transformers-base

66− , vinyl

68source-repository head

69 type: git

squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+7−8

@@ -15,8 +15,7 @@ import Control.Arrow (left)

15import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)

16import Data.ByteString (ByteString)

17import Data.Int (Int16,Int32,Int64)

18−import Data.Vinyl

18+import Generics.SOP

19−import Data.Vinyl.Functor

20import PostgreSQL.Binary.Decoding (Value)

19import PostgreSQL.Binary.Decoding (Value)

21import PostgreSQL.Binary.Encoding (Encoding)

20import PostgreSQL.Binary.Encoding (Encoding)

22import Data.Scientific (Scientific)

21import Data.Scientific (Scientific)

@@ -84,13 +83,13 @@ instance FromValue pg ty => FromValue (column ::: 'Required ('NotNull pg)) ty wh

84 fromValue _ = fromValue (proxy# :: Proxy# pg)

83 fromValue _ = fromValue (proxy# :: Proxy# pg)

86class FromValues pgs xs where

85class FromValues pgs xs where

87− decodeValues :: Proxy# pgs -> Rec (Const ByteString) xs -> Rec (Either Text) xs

86+ decodeValues :: Proxy# pgs -> NP (K ByteString) xs -> NP (Either Text) xs

88−instance FromValues '[] '[] where decodeValues _ _ = RNil

87+instance FromValues '[] '[] where decodeValues _ _ = Nil

89instance (FromValue pg x, FromValues pgs xs)

88instance (FromValue pg x, FromValues pgs xs)

90 => FromValues (pg ': pgs) (x ': xs) where

89 => FromValues (pg ': pgs) (x ': xs) where

91− decodeValues _ (Const result :& results) =

90+ decodeValues _ (K result :* results) =

92 decodeValue (proxy# :: Proxy# pg) result

91 decodeValue (proxy# :: Proxy# pg) result

93− :& decodeValues (proxy# :: Proxy# pgs) results

92+ :* decodeValues (proxy# :: Proxy# pgs) results

95class ToValue x pg where

94class ToValue x pg where

96 toValue :: Proxy# pg -> x -> Encoding

95 toValue :: Proxy# pg -> x -> Encoding

@@ -138,10 +137,10 @@ instance ToValue DiffTime 'PGInterval where

138 toValue _ = Encoder.interval_int

137 toValue _ = Encoder.interval_int

139

138

140class ToValues xs pgs where

139class ToValues xs pgs where

141− toValues :: Proxy# pgs -> Rec Identity xs -> [ByteString]

140+ toValues :: Proxy# pgs -> NP I xs -> [ByteString]

142instance ToValues '[] '[] where toValues _ _ = []

141instance ToValues '[] '[] where toValues _ _ = []

143instance (ToValue x pg, ToValues xs pgs)

142instance (ToValue x pg, ToValues xs pgs)

144 => ToValues (x ': xs) (pg ': pgs) where

143 => ToValues (x ': xs) (pg ': pgs) where

145− toValues _ (Identity x :& xs)

144+ toValues _ (I x :* xs)

146 = Encoder.encodingBytes ((toValue (proxy# :: Proxy# pg)) x)

145 = Encoder.encodingBytes ((toValue (proxy# :: Proxy# pg)) x)

147 : toValues (proxy# :: Proxy# pgs) xs

146 : toValues (proxy# :: Proxy# pgs) xs

squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+3−4

@@ -23,8 +23,7 @@ import Control.Monad.Trans

23import Control.Monad.Trans.Control

24import Data.ByteString (ByteString)

25import Data.Text (Text)

26−import Data.Vinyl

26+import Generics.SOP

27−import Data.Vinyl.Functor

28import GHC.Exts

27import GHC.Exts

29import GHC.TypeLits

28import GHC.TypeLits

@@ -72,7 +71,7 @@ class MonadPQ pq where

72 pqExecParams

71 pqExecParams

73 :: (MonadBase IO io, ToOids ps, ToValues xs ps)

72 :: (MonadBase IO io, ToOids ps, ToValues xs ps)

74 => Statement ps ys db0 db1

73 => Statement ps ys db0 db1

75− -> Rec Identity xs

74+ -> NP I xs

76 -> pq db0 db1 io (Maybe (Result ys))

75 -> pq db0 db1 io (Maybe (Result ys))

78 pqPrepare

77 pqPrepare

@@ -84,7 +83,7 @@ class MonadPQ pq where

84 pqExecPrepared

83 pqExecPrepared

85 :: (MonadBase IO io, ToValues xs ps)

84 :: (MonadBase IO io, ToValues xs ps)

86 => PreparedStatement ps ys db0 db1

85 => PreparedStatement ps ys db0 db1

87− -> Rec Identity xs

86+ -> NP I xs

88 -> pq db0 db1 io (Maybe (Result ys))

87 -> pq db0 db1 io (Maybe (Result ys))

90instance MonadPQ PQ where

89instance MonadPQ PQ where

squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+28−28

@@ -20,8 +20,7 @@ import Data.ByteString (ByteString)

20import Data.Maybe

21import Data.Monoid

22import Data.String

23−import Data.Vinyl

23+import Generics.SOP

24−import Data.Vinyl.Functor

25import GHC.Exts

24import GHC.Exts

26import GHC.OverloadedLabels

25import GHC.OverloadedLabels

27import GHC.TypeLits

26import GHC.TypeLits

@@ -117,8 +116,8 @@ unsafeFunction

117 :: ByteString

116 :: ByteString

118 -> Expression params tables xty

117 -> Expression params tables xty

119 -> Expression params tables yty

118 -> Expression params tables yty

120−unsafeFunction fn x = UnsafeExpression $ mconcat

119+unsafeFunction fun x = UnsafeExpression $ mconcat

121− [fn, "(", renderExpression x, ")"]

120+ [fun, "(", renderExpression x, ")"]

122

121

123instance PGNum ty => Num (Expression params tables ('Required (nullity ty))) where

122instance PGNum ty => Num (Expression params tables ('Required (nullity ty))) where

124 (+) = unsafeBinaryOp "+"

123 (+) = unsafeBinaryOp "+"

@@ -407,7 +406,8 @@ Alias tab `dotStarFrom` tabs = UnsafeSelection $

407 fromString (symbolVal' tab) <> ".* FROM " <> renderFrom tabs

406 fromString (symbolVal' tab) <> ".* FROM " <> renderFrom tabs

408

407

409from

408from

409+ :: SListI columns

410− :: Rec (Aliased (Expression params tables)) columns

410+ => NP (Aliased (Expression params tables)) columns

411 -> From params schema tables

412 -> Selection params schema columns

413list `from` tabs = UnsafeSelection $

@@ -415,8 +415,8 @@ list `from` tabs = UnsafeSelection $

415 where

416 renderList

417 = ByteString.intercalate ", "

418− . recordToList

418+ . hcollapse

419− . rmap (Const . renderAliased renderExpression)

419+ . hmap (K . renderAliased renderExpression)

420

421select

422 :: Selection params schema columns

@@ -436,9 +436,9 @@ INSERT statements

436-----------------------------------------}

437

438insertInto

439− :: HasTable table schema columns

439+ :: (SListI columns, HasTable table schema columns)

440 => Alias table

441− -> Rec (Aliased (Expression params '[])) columns

441+ -> NP (Aliased (Expression params '[])) columns

442 -> Statement params '[] schema schema

443insertInto (Alias table) expressions = UnsafeStatement $ "INSERT INTO "

444 <> fromString (symbolVal' table)

@@ -447,11 +447,11 @@ insertInto (Alias table) expressions = UnsafeStatement $ "INSERT INTO "

447 <> ByteString.intercalate ", " values

448 <> ");"

449 where

450− aliases = recordToList $ rmap

450+ aliases = hcollapse $ hmap

451− (\ (_ `As` Alias name) -> Const (fromString (symbolVal' name)))

451+ (\ (_ `As` Alias name) -> K (fromString (symbolVal' name)))

452 expressions

453− values = recordToList $ rmap

453+ values = hcollapse $ hmap

454− (\ (expression `As` _) -> Const (renderExpression expression))

454+ (\ (expression `As` _) -> K (renderExpression expression))

455 expressions

456

457{-----------------------------------------

@@ -486,16 +486,16 @@ serial :: TypeExpression ('Optional ('NotNull 'PGInt4))

486serial = UnsafeTypeExpression "serial"

487

488createTable

489− :: KnownSymbol table

489+ :: (KnownSymbol table, SListI columns)

490 => Alias table

491− -> Rec (Aliased TypeExpression) columns

491+ -> NP (Aliased TypeExpression) columns

492 -> Statement '[] '[] schema ((table ::: columns) ': schema)

493createTable (Alias table) columns = UnsafeStatement $ mconcat

494 [ "CREATE TABLE "

495 , fromString $ symbolVal' table

496 , " ("

497− , ByteString.intercalate ", " . recordToList $

497+ , ByteString.intercalate ", " . hcollapse $

498− rmap (Const . renderColumn) columns

498+ hmap (K . renderColumn) columns

499 , ");"

500 ]

501 where

@@ -523,33 +523,33 @@ instance {-# OVERLAPPABLE #-}

523UPDATE statements

524-----------------------------------------}

525

526−set :: g x -> (Maybe `Compose` g) x

526+set :: g x -> (Maybe :.: g) x

527−set = Compose . Just

527+set = Comp . Just

528

529−same :: (Maybe `Compose` g) x

529+same :: (Maybe :.: g) x

530−same = Compose Nothing

530+same = Comp Nothing

531

532update

533− :: HasTable table schema columns

533+ :: (HasTable table schema columns, SListI columns)

534 => Alias table

535− -> Rec (Aliased (Maybe `Compose` Expression params '[table ::: columns])) columns

535+ -> NP (Aliased (Maybe :.: Expression params '[table ::: columns])) columns

536 -> Expression params '[table ::: columns] ('Required ('NotNull 'PGBool))

537 -> Statement params '[] schema schema

538update (Alias table) columns where' = UnsafeStatement $ mconcat

539 [ "UPDATE "

540 , fromString $ symbolVal' table

541 , " SET "

542− , ByteString.intercalate ", " . catMaybes . recordToList $

542+ , ByteString.intercalate ", " . catMaybes . hcollapse $

543− rmap (Const . renderSet) columns

543+ hmap (K . renderSet) columns

544 , " WHERE ", renderExpression where'

545 ] where

546 renderSet

547− :: Aliased (Maybe `Compose` Expression params tables) column

547+ :: Aliased (Maybe :.: Expression params tables) column

548 -> Maybe ByteString

549 renderSet = \case

550− Compose (Just expression) `As` Alias column -> Just $ mconcat

550+ Comp (Just expression) `As` Alias column -> Just $ mconcat

551 [ fromString $ symbolVal' column

552 , " = "

553 , renderExpression expression

554 ]

555− Compose Nothing `As` _ -> Nothing

555+ Comp Nothing `As` _ -> Nothing

squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+13−13

@@ -10,7 +10,7 @@ module Squeel.PostgreSQL.StatementSpec where

11import Data.Boolean

12import Data.Function

13−import Data.Vinyl

13+import Generics.SOP hiding (from)

14import Test.Hspec

16import Squeel.PostgreSQL.Statement

@@ -24,7 +24,7 @@ spec = do

24 let

25 statement :: Statement '[] SumAndCol1 Tables Tables

26 statement = select $

27− ((#col1 + #col2) `As` #sum :& #col1 :& RNil)

27+ ((#col1 + #col2) `As` #sum :* #col1 :* Nil)

28 `from` (#table1 & where_ true)

29 statement `shouldRenderAs`

30 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE TRUE;"

@@ -32,13 +32,13 @@ spec = do

32 let

33 statement :: Statement '[] SumAndCol1 Tables Tables

34 statement = select $

35− ((#col1 + #col2) `As` #sum :& #col1 :& RNil)

35+ ((#col1 + #col2) `As` #sum :* #col1 :* Nil)

36 `from` (#table1 & where_ true & where_ false)

37 statement `shouldRenderAs`

38 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (TRUE AND FALSE);"

39 it "performs sub SELECTs" $ do

40 let

41− selection = ((#col1 + #col2) `As` #sum :& #col1 :& RNil) `from` #table1

41+ selection = ((#col1 + #col2) `As` #sum :* #col1 :* Nil) `from` #table1

42 statement :: Statement '[] SumAndCol1 Tables Tables

43 statement = select $ starFrom (subselect (selection `As` #sub))

44 statement `shouldRenderAs`

@@ -72,22 +72,22 @@ spec = do

72 it "correctly render simple INSERTs" $ do

73 let

74 statement :: Statement '[] '[] Tables Tables

75− statement = insertInto #table1 $ 2 `As` #col1 :& 4 `As` #col2 :& RNil

75+ statement = insertInto #table1 $ 2 `As` #col1 :* 4 `As` #col2 :* Nil

76 statement `shouldRenderAs`

77 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"

78 it "should be safe against SQL injection in literal text" $ do

79 let

80 statement :: Statement '[] '[] StudentsTable StudentsTable

81 statement = insertInto #students $

82− "Robert'); DROP TABLE students;" `As` #name :& RNil

82+ "Robert'); DROP TABLE students;" `As` #name :* Nil

83 statement `shouldRenderAs`

84 "INSERT INTO students (name) VALUES (E'Robert''); DROP TABLE students;');"

85 describe "JOINs" $ do

86 let

87 vals =

88 #orders &. #orderVal `As` #orderVal

89− :& #customers &. #customerVal `As` #customerVal

89+ :* #customers &. #customerVal `As` #customerVal

90− :& #shippers &. #shipperVal `As` #shipperVal :& RNil

90+ :* #shippers &. #shipperVal `As` #shipperVal :* Nil

91 it "should render CROSS JOINs" $ do

92 let

93 statement :: Statement '[] ValueColumns JoinTables JoinTables

@@ -135,15 +135,15 @@ spec = do

135 it "should render CREATE TABLE statements" $ do

136 createTable #table1

137 ( (int4 & notNull) `As` #col1

138− :& (int4 & notNull) `As` #col2

138+ :* (int4 & notNull) `As` #col2

139− :& RNil)

139+ :* Nil)

140 `shouldRenderAs`

141 "CREATE TABLE table1 (col1 int4 NOT NULL, col2 int4 NOT NULL);"

142 createTable #table2

143 ( serial `As` #col1

144− :& text `As` #col2

144+ :* text `As` #col2

145− :& (int8 & notNull & default_ 8) `As` #col3

145+ :* (int8 & notNull & default_ 8) `As` #col3

146− :& RNil)

146+ :* Nil)

147 `shouldRenderAs`

148 "CREATE TABLE table2 (col1 serial, col2 text, col3 int8 NOT NULL DEFAULT 8);"

149 it "should render DROP TABLE statements" $ do