0eafb7b · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

style

0eafb7bEitan Chatav9 years ago

squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+4

compare with dev

unifiedsplit

@@ -22,6 +22,7 @@ module Squeel.PostgreSQL.Schema

22 , PGFloating

23 , (:::)

24 , Alias (Alias)

25+ , renderAlias

25 , Aliased (As)

26 , Aliased (As)

26 , renderAliased

27 , renderAliased

27 , NullityType (..)

28 , NullityType (..)

@@ -108,6 +109,9 @@ type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)

108

109

109data Alias (alias :: Symbol) = Alias (Proxy# alias)

110data Alias (alias :: Symbol) = Alias (Proxy# alias)

110

111

112+renderAlias :: KnownSymbol alias => Alias alias -> ByteString

113+renderAlias (Alias alias) = fromString (symbolVal' alias)

114+

111instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where

115instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where

112 fromLabel = Alias

116 fromLabel = Alias

113

117

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

@@ -78,10 +78,8 @@ instance (HasColumn column columns ty, tables ~ '[table ::: columns])

78(&.)

79 :: (HasTable table tables columns, HasColumn column columns ty)

80 => Alias table -> Alias column -> Expression params tables ty

81−Alias table &. Alias column = UnsafeExpression $

81+table &. column = UnsafeExpression $

82− fromString (symbolVal' table)

82+ renderAlias table <> "." <> renderAlias column

83− <> "." <>

84− fromString (symbolVal' column)

86def :: Expression params '[] ('Optional (nullity ty))

84def :: Expression params '[] ('Optional (nullity ty))

87def = UnsafeExpression "DEFAULT"

85def = UnsafeExpression "DEFAULT"

@@ -691,8 +689,8 @@ dotStarFrom

691 => Alias table

689 => Alias table

692 -> TableExpression params schema tables

690 -> TableExpression params schema tables

693 -> Selection params schema columns

691 -> Selection params schema columns

694−Alias tab `dotStarFrom` tabs = UnsafeSelection $

692+table `dotStarFrom` tables = UnsafeSelection $

695− fromString (symbolVal' tab) <> ".* FROM " <> renderTableExpression tabs

693+ renderAlias table <> ".* FROM " <> renderTableExpression tables

696

694

697from

695from

698 :: SListI columns

696 :: SListI columns

@@ -726,9 +724,9 @@ createTable

726 => Alias table

724 => Alias table

727 -> NP (Aliased TypeExpression) columns

725 -> NP (Aliased TypeExpression) columns

728 -> Statement '[] '[] schema (Create table columns schema)

726 -> Statement '[] '[] schema (Create table columns schema)

729−createTable (Alias table) columns = UnsafeStatement $ mconcat

727+createTable table columns = UnsafeStatement $ mconcat

730 [ "CREATE TABLE "

728 [ "CREATE TABLE "

731− , fromString $ symbolVal' table

729+ , renderAlias table

732 , " ("

730 , " ("

733 , ByteString.intercalate ", " . hcollapse $

731 , ByteString.intercalate ", " . hcollapse $

734 hmap (K . renderColumn) columns

732 hmap (K . renderColumn) columns

@@ -736,8 +734,8 @@ createTable (Alias table) columns = UnsafeStatement $ mconcat

736 ]

734 ]

737 where

735 where

738 renderColumn :: Aliased TypeExpression x -> ByteString

736 renderColumn :: Aliased TypeExpression x -> ByteString

739− renderColumn (ty `As` Alias column) =

737+ renderColumn (ty `As` column) =

740− fromString (symbolVal' column) <> " " <> renderTypeExpression ty

738+ renderAlias column <> " " <> renderTypeExpression ty

741

739

742{-----------------------------------------

740{-----------------------------------------

743DROP statements

741DROP statements

@@ -747,8 +745,8 @@ dropTable

747 :: KnownSymbol table

745 :: KnownSymbol table

748 => Alias table

746 => Alias table

749 -> Statement '[] '[] schema (Drop table schema)

747 -> Statement '[] '[] schema (Drop table schema)

750−dropTable (Alias table) = UnsafeStatement $

748+dropTable table = UnsafeStatement $

751− "DROP TABLE " <> fromString (symbolVal' table) <> ";"

749+ "DROP TABLE " <> renderAlias table <> ";"

752

750

753{-----------------------------------------

751{-----------------------------------------

754ALTER statements

752ALTER statements

@@ -759,9 +757,9 @@ alterTable

759 => Alias table

757 => Alias table

760 -> AlterTable columns0 columns1

758 -> AlterTable columns0 columns1

761 -> Statement '[] '[] schema (Alter table schema columns1)

759 -> Statement '[] '[] schema (Alter table schema columns1)

762−alterTable (Alias table) alteration = UnsafeStatement $

760+alterTable table alteration = UnsafeStatement $

763 "ALTER TABLE "

761 "ALTER TABLE "

764− <> fromString (symbolVal' table)

762+ <> renderAlias table

765 <> " "

763 <> " "

766 <> renderAlterTable alteration

764 <> renderAlterTable alteration

767 <> ";"

765 <> ";"

@@ -771,11 +769,11 @@ alterTableRename

771 => Alias table0

769 => Alias table0

772 -> Alias table1

770 -> Alias table1

773 -> Statement '[] '[] schema (Rename table0 table1 schema)

771 -> Statement '[] '[] schema (Rename table0 table1 schema)

774−alterTableRename (Alias table0) (Alias table1) = UnsafeStatement $

772+alterTableRename table0 table1 = UnsafeStatement $

775 "ALTER TABLE "

773 "ALTER TABLE "

776− <> fromString (symbolVal' table0)

774+ <> renderAlias table0

777 <> " RENAME TO "

775 <> " RENAME TO "

778− <> fromString (symbolVal' table1)

776+ <> renderAlias table1

779 <> ";"

777 <> ";"

780

778

781data AlterTable

779data AlterTable

@@ -788,9 +786,9 @@ addColumnDefault

788 => Alias column

786 => Alias column

789 -> TypeExpression ('Optional ty)

787 -> TypeExpression ('Optional ty)

790 -> AlterTable columns (Create column ('Optional ty) columns)

788 -> AlterTable columns (Create column ('Optional ty) columns)

791−addColumnDefault (Alias column) ty = UnsafeAlterTable $

789+addColumnDefault column ty = UnsafeAlterTable $

792 "ADD COLUMN "

790 "ADD COLUMN "

793− <> fromString (symbolVal' column)

791+ <> renderAlias column

794 <> " "

792 <> " "

795 <> renderTypeExpression ty

793 <> renderTypeExpression ty

796

794

@@ -799,9 +797,9 @@ addColumnNull

799 => Alias column

797 => Alias column

800 -> TypeExpression ('Required ('Null ty))

798 -> TypeExpression ('Required ('Null ty))

801 -> AlterTable columns ((column ::: 'Required ('Null ty)) ': columns)

799 -> AlterTable columns ((column ::: 'Required ('Null ty)) ': columns)

802−addColumnNull (Alias column) ty = UnsafeAlterTable $

800+addColumnNull column ty = UnsafeAlterTable $

803 "ADD COLUMN "

801 "ADD COLUMN "

804− <> fromString (symbolVal' column)

802+ <> renderAlias column

805 <> " "

803 <> " "

806 <> renderTypeExpression ty

804 <> renderTypeExpression ty

807

805

@@ -809,25 +807,25 @@ dropColumn

809 :: KnownSymbol column

807 :: KnownSymbol column

810 => Alias column

808 => Alias column

811 -> AlterTable columns (Drop column columns)

809 -> AlterTable columns (Drop column columns)

812−dropColumn (Alias column) = UnsafeAlterTable $

810+dropColumn column = UnsafeAlterTable $

813− "DROP COLUMN " <> fromString (symbolVal' column)

811+ "DROP COLUMN " <> renderAlias column

814

812

815renameColumn

813renameColumn

816 :: (KnownSymbol column0, KnownSymbol column1)

814 :: (KnownSymbol column0, KnownSymbol column1)

817 => Alias column0

815 => Alias column0

818 -> Alias column1

816 -> Alias column1

819 -> AlterTable columns (Rename column0 column1 columns)

817 -> AlterTable columns (Rename column0 column1 columns)

820−renameColumn (Alias column0) (Alias column1) = UnsafeAlterTable $

818+renameColumn column0 column1 = UnsafeAlterTable $

821− "RENAME COLUMN " <> fromString (symbolVal' column0)

819+ "RENAME COLUMN " <> renderAlias column0

822− <> " TO " <> fromString (symbolVal' column1)

820+ <> " TO " <> renderAlias column1

823

821

824alterColumn

822alterColumn

825 :: (KnownSymbol column, HasColumn column columns ty0)

823 :: (KnownSymbol column, HasColumn column columns ty0)

826 => Alias column

824 => Alias column

827 -> AlterColumn ty0 ty1

825 -> AlterColumn ty0 ty1

828 -> AlterTable columns (Alter column columns ty1)

826 -> AlterTable columns (Alter column columns ty1)

829−alterColumn (Alias column) alteration = UnsafeAlterTable $

827+alterColumn column alteration = UnsafeAlterTable $

830− "ALTER COLUMN " <> fromString (symbolVal' column)

828+ "ALTER COLUMN " <> renderAlias column

831 <> " " <> renderAlterColumn alteration

829 <> " " <> renderAlterColumn alteration

832

830

833data AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =

831data AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =

@@ -865,15 +863,15 @@ insertInto

865 => Alias table

863 => Alias table

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

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

867 -> Statement params '[] schema schema

865 -> Statement params '[] schema schema

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

866+insertInto table expressions = UnsafeStatement $ "INSERT INTO "

869− <> fromString (symbolVal' table)

867+ <> renderAlias table

870 <> " (" <> ByteString.intercalate ", " aliases

868 <> " (" <> ByteString.intercalate ", " aliases

871 <> ") VALUES ("

869 <> ") VALUES ("

872 <> ByteString.intercalate ", " values

870 <> ByteString.intercalate ", " values

873 <> ");"

871 <> ");"

874 where

872 where

875 aliases = hcollapse $ hmap

873 aliases = hcollapse $ hmap

876− (\ (_ `As` Alias name) -> K (fromString (symbolVal' name)))

874+ (\ (_ `As` name) -> K (renderAlias name))

877 expressions

875 expressions

878 values = hcollapse $ hmap

876 values = hcollapse $ hmap

879 (\ (expression `As` _) -> K (renderExpression expression))

877 (\ (expression `As` _) -> K (renderExpression expression))

@@ -885,10 +883,10 @@ insertIntoReturning

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

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

886 -> NP (Aliased (Expression params '[table ::: columns])) results

884 -> NP (Aliased (Expression params '[table ::: columns])) results

887 -> Statement params results schema schema

885 -> Statement params results schema schema

888−insertIntoReturning (Alias table) inserts results

886+insertIntoReturning table inserts results

889 = UnsafeStatement . mconcat $

887 = UnsafeStatement . mconcat $

890 [ "INSERT INTO "

888 [ "INSERT INTO "

891− , fromString (symbolVal' table)

889+ , renderAlias table

892 , " (" <> ByteString.intercalate ", " aliases

890 , " (" <> ByteString.intercalate ", " aliases

893 , ") VALUES ("

891 , ") VALUES ("

894 , ByteString.intercalate ", " values

892 , ByteString.intercalate ", " values

@@ -898,7 +896,7 @@ insertIntoReturning (Alias table) inserts results

898 ]

896 ]

899 where

897 where

900 aliases = hcollapse $ hmap

898 aliases = hcollapse $ hmap

901− (\ (_ `As` Alias name) -> K (fromString (symbolVal' name)))

899+ (\ (_ `As` name) -> K (renderAlias name))

902 inserts

900 inserts

903 values = hcollapse $ hmap

901 values = hcollapse $ hmap

904 (\ (expression `As` _) -> K (renderExpression expression))

902 (\ (expression `As` _) -> K (renderExpression expression))

@@ -912,51 +910,49 @@ insertIntoReturning (Alias table) inserts results

912UPDATE statements

910UPDATE statements

913-----------------------------------------}

911-----------------------------------------}

914

912

913+data UpdateExpression params table ty

914+ = Same

915−set :: Expression params tables x -> (Maybe :.: Expression params tables) x

915+ | Set (Expression params table ty)

916−set = Comp . Just

917

916

918−same :: (Maybe :.: Expression params tables) x

917+renderUpdateExpression

919−same = Comp Nothing

920−

921−renderSet

922− :: Aliased (Maybe :.: Expression params '[table ::: columns]) column

918+ :: Aliased (UpdateExpression params '[table ::: columns]) column

923 -> Maybe ByteString

919 -> Maybe ByteString

924−renderSet = \case

920+renderUpdateExpression = \case

921+ Same `As` _ -> Nothing

925− Comp (Just expression) `As` Alias column -> Just $ mconcat

922+ Set expression `As` column -> Just $ mconcat

926− [ fromString $ symbolVal' column

923+ [ renderAlias column

927 , " = "

924 , " = "

928 , renderExpression expression

925 , renderExpression expression

929 ]

926 ]

930− Comp Nothing `As` _ -> Nothing

931

927

932update

928update

933 :: (HasTable table schema columns, SListI columns)

929 :: (HasTable table schema columns, SListI columns)

934 => Alias table

930 => Alias table

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

931+ -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns

936 -> Predicate params '[table ::: columns]

932 -> Predicate params '[table ::: columns]

937 -> Statement params '[] schema schema

933 -> Statement params '[] schema schema

938−update (Alias table) columns wh = UnsafeStatement $ mconcat

934+update table columns wh = UnsafeStatement $ mconcat

939 [ "UPDATE "

935 [ "UPDATE "

940− , fromString $ symbolVal' table

936+ , renderAlias table

941 , " SET "

937 , " SET "

942 , ByteString.intercalate ", " . catMaybes . hcollapse $

938 , ByteString.intercalate ", " . catMaybes . hcollapse $

943− hmap (K . renderSet) columns

939+ hmap (K . renderUpdateExpression) columns

944 , " WHERE ", renderExpression wh, ";"

940 , " WHERE ", renderExpression wh, ";"

945 ]

941 ]

946

942

947updateReturning

943updateReturning

948 :: (SListI columns, SListI results, HasTable table schema columns)

944 :: (SListI columns, SListI results, HasTable table schema columns)

949 => Alias table

945 => Alias table

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

946+ -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns

951 -> Predicate params '[table ::: columns]

947 -> Predicate params '[table ::: columns]

952 -> NP (Aliased (Expression params '[table ::: columns])) results

948 -> NP (Aliased (Expression params '[table ::: columns])) results

953 -> Statement params results schema schema

949 -> Statement params results schema schema

954−updateReturning (Alias table) updates wh results = UnsafeStatement $ mconcat

950+updateReturning table updates wh results = UnsafeStatement $ mconcat

955 [ "UPDATE "

951 [ "UPDATE "

956− , fromString $ symbolVal' table

952+ , renderAlias table

957 , " SET "

953 , " SET "

958 , ByteString.intercalate ", " . catMaybes . hcollapse $

954 , ByteString.intercalate ", " . catMaybes . hcollapse $

959− hmap (K . renderSet) updates

955+ hmap (K . renderUpdateExpression) updates

960 , " WHERE ", renderExpression wh

956 , " WHERE ", renderExpression wh

961 , " RETURNING ", renderList results

957 , " RETURNING ", renderList results

962 , ";"

958 , ";"

@@ -971,24 +967,24 @@ upsertInto

971 :: (SListI columns, HasTable table schema columns)

967 :: (SListI columns, HasTable table schema columns)

972 => Alias table

968 => Alias table

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

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

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

970+ -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns

975 -> Predicate params '[table ::: columns]

971 -> Predicate params '[table ::: columns]

976 -> Statement params '[] schema schema

972 -> Statement params '[] schema schema

977−upsertInto (Alias table) inserts updates wh = UnsafeStatement . mconcat $

973+upsertInto table inserts updates wh = UnsafeStatement . mconcat $

978 [ "INSERT INTO "

974 [ "INSERT INTO "

979− , fromString (symbolVal' table)

975+ , renderAlias table

980 , " (" <> ByteString.intercalate ", " aliases

976 , " (" <> ByteString.intercalate ", " aliases

981 , ") VALUES ("

977 , ") VALUES ("

982 , ByteString.intercalate ", " values

978 , ByteString.intercalate ", " values

983 , ") ON CONFLICT UPDATE "

979 , ") ON CONFLICT UPDATE "

984− , fromString $ symbolVal' table

980+ , renderAlias table

985 , " SET "

981 , " SET "

986 , ByteString.intercalate ", " . catMaybes . hcollapse $

982 , ByteString.intercalate ", " . catMaybes . hcollapse $

987− hmap (K . renderSet) updates

983+ hmap (K . renderUpdateExpression) updates

988 , " WHERE ", renderExpression wh, ";"

984 , " WHERE ", renderExpression wh, ";"

989 ] where

985 ] where

990 aliases = hcollapse $ hmap

986 aliases = hcollapse $ hmap

991− (\ (_ `As` Alias name) -> K (fromString (symbolVal' name)))

987+ (\ (_ `As` name) -> K (renderAlias name))

992 inserts

988 inserts

993 values = hcollapse $ hmap

989 values = hcollapse $ hmap

994 (\ (expression `As` _) -> K (renderExpression expression))

990 (\ (expression `As` _) -> K (renderExpression expression))

@@ -998,35 +994,36 @@ upsertIntoReturning

998 :: (SListI columns, SListI results, HasTable table schema columns)

994 :: (SListI columns, SListI results, HasTable table schema columns)

999 => Alias table

995 => Alias table

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

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

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

997+ -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns

1002 -> Predicate params '[table ::: columns]

998 -> Predicate params '[table ::: columns]

1003 -> NP (Aliased (Expression params '[table ::: columns])) results

999 -> NP (Aliased (Expression params '[table ::: columns])) results

1004 -> Statement params results schema schema

1000 -> Statement params results schema schema

1005−upsertIntoReturning (Alias table) inserts updates wh results = UnsafeStatement . mconcat $

1001+upsertIntoReturning table inserts updates wh results =

1002+ UnsafeStatement . mconcat $

1006− [ "INSERT INTO "

1003+ [ "INSERT INTO "

1007− , fromString (symbolVal' table)

1004+ , renderAlias table

1008− , " (" <> ByteString.intercalate ", " aliases

1005+ , " (" <> ByteString.intercalate ", " aliases

1009− , ") VALUES ("

1006+ , ") VALUES ("

1010− , ByteString.intercalate ", " values

1007+ , ByteString.intercalate ", " values

1011− , ") ON CONFLICT UPDATE "

1008+ , ") ON CONFLICT UPDATE "

1012− , fromString $ symbolVal' table

1009+ , renderAlias table

1013− , " SET "

1010+ , " SET "

1014− , ByteString.intercalate ", " . catMaybes . hcollapse $

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

1015− hmap (K . renderSet) updates

1012+ hmap (K . renderUpdateExpression) updates

1016− , " WHERE ", renderExpression wh

1013+ , " WHERE ", renderExpression wh

1017− , " RETURNING ", renderList results

1014+ , " RETURNING ", renderList results

1018− , ";"

1015+ , ";"

1019− ] where

1016+ ] where

1020− aliases = hcollapse $ hmap

1017+ aliases = hcollapse $ hmap

1021− (\ (_ `As` Alias name) -> K (fromString (symbolVal' name)))

1018+ (\ (_ `As` name) -> K (renderAlias name))

1022− inserts

1019+ inserts

1023− values = hcollapse $ hmap

1020+ values = hcollapse $ hmap

1024− (\ (expression `As` _) -> K (renderExpression expression))

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

1025− inserts

1022+ inserts

1026− renderList

1023+ renderList

1027− = ByteString.intercalate ", "

1024+ = ByteString.intercalate ", "

1028− . hcollapse

1025+ . hcollapse

1029− . hmap (K . renderAliased renderExpression)

1026+ . hmap (K . renderAliased renderExpression)

1030

1027

1031{-----------------------------------------

1028{-----------------------------------------

1032DELETE statements

1029DELETE statements

@@ -1037,8 +1034,8 @@ deleteFrom

1037 => Alias table

1034 => Alias table

1038 -> Predicate params '[table ::: columns]

1035 -> Predicate params '[table ::: columns]

1039 -> Statement params '[] schema schema

1036 -> Statement params '[] schema schema

1040−deleteFrom (Alias table) wh = UnsafeStatement $ mconcat

1037+deleteFrom table wh = UnsafeStatement $ mconcat

1041 [ "DELETE FROM "

1038 [ "DELETE FROM "

1042− , fromString $ symbolVal' table

1039+ , renderAlias table

1043 , " WHERE ", renderExpression wh, ";"

1040 , " WHERE ", renderExpression wh, ";"

1044 ]

1041 ]

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

@@ -85,14 +85,14 @@ spec = do

85 it "correctly renders simple UPDATEs" $ do

86 let

87 statement :: Statement '[] '[] Tables Tables

88− statement = update #table1 (set 2 `As` #col1 :* same `As` #col2 :* Nil) (#col1 /=* #col2)

88+ statement = update #table1 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil) (#col1 /=* #col2)

89 statement `shouldRenderAs`

90 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"

91 it "correctly renders returning UPDATEs" $ do

92 let

93 statement :: Statement '[] SumAndCol1 Tables Tables

94 statement = updateReturning #table1

95− (set 2 `As` #col1 :* same `As` #col2 :* Nil)

95+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)

96 (#col1 /=* #col2)

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

98 statement `shouldRenderAs`

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

102 statement :: Statement '[] '[] Tables Tables

103 statement = upsertInto #table1

104 (2 `As` #col1 :* 4 `As` #col2 :* Nil)

105− (set 2 `As` #col1 :* same `As` #col2 :* Nil)

105+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)

106 (#col1 /=* #col2)

107 statement `shouldRenderAs`

108 "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"

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

111 statement :: Statement '[] SumAndCol1 Tables Tables

112 statement = upsertIntoReturning #table1

113 (2 `As` #col1 :* 4 `As` #col2 :* Nil)

114− (set 2 `As` #col1 :* same `As` #col2 :* Nil)

114+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)

115 (#col1 /=* #col2)

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

117 statement `shouldRenderAs`