/src-extra/tests/Database/HsSqlPpp/Tests/junk/ExtensionTests.lhs

http://github.com/JakeWheat/hssqlppp · Haskell · 178 lines · 175 code · 3 blank · 0 comment · 11 complexity · 3d54011529b800187a93e07bb973b6ae MD5 · raw file

  1. Set of tests for the old chaosextensions, in the process of being
  2. replaced
  3. > module Database.HsSqlPpp.Tests.ExtensionTests (extensionTests) where
  4. >
  5. > import Test.HUnit
  6. > import Test.Framework
  7. > import Test.Framework.Providers.HUnit
  8. > --import Debug.Trace
  9. >
  10. > import Database.HsSqlPpp.Parser
  11. > import Database.HsSqlPpp.Annotation
  12. > import ChaosExtensions
  13. > import Database.HsSqlPpp.Ast
  14. > --import Database.HsSqlPpp.PrettyPrinter.PrettyPrinter
  15. >
  16. > extensionTests :: Test.Framework.Test
  17. > extensionTests =
  18. > testGroup "extensionTests" (mapCheckExtension [
  19. > t rewriteCreateVars
  20. > "select create_var('varname','vartype');"
  21. > "create table varname_table (\n\
  22. > \ varname vartype);\n\
  23. > \create function get_varname() returns vartype as $a$\n\
  24. > \ select * from varname_table;\n\
  25. > \$a$ language sql stable;\n\
  26. > \create function check_con_varname_table_varname_key() returns boolean as $a$\n\
  27. > \begin\n\
  28. > \ return true;\n\
  29. > \end;\n\
  30. > \$a$ language plpgsql stable;\n\
  31. > \/*drop function if exists varname_table_constraint_trigger_operator();\n\
  32. > \create function varname_table_constraint_trigger_operator() returns trigger as $a$\n\
  33. > \begin\n\
  34. > \ null;\n\
  35. > \end;\n\
  36. > \$a$ language plpgsql;*/\n\
  37. > \create function check_con_varname_table_01_tuple() returns boolean as $a$\n\
  38. > \begin\n\
  39. > \ return true;\n\
  40. > \end;\n\
  41. > \$a$ language plpgsql stable;\n\
  42. > \drop function if exists varname_table_constraint_trigger_operator();\n\
  43. > \create function varname_table_constraint_trigger_operator() returns trigger as $a$\n\
  44. > \begin\n\
  45. > \ null;\n\
  46. > \end;\n\
  47. > \$a$ language plpgsql;"
  48. >
  49. > ,t addReadonlyTriggers
  50. > "select set_relvar_type('stuff','readonly');"
  51. > "create function check_stuff_d_readonly() returns trigger as $a$\n\
  52. > \begin\n\
  53. > \ if (not (false)) then\n\
  54. > \ raise exception 'delete on base_relvar_metadata violates transition constraint base_relvar_metadata_d_readonly';\n\
  55. > \ end if;\n\
  56. > \return null;\n\
  57. > \end;\n\
  58. > \$a$ language plpgsql volatile;\n\
  59. > \create function check_stuff_i_readonly() returns trigger as $a$\n\
  60. > \begin\n\
  61. > \ if (not (false)) then\n\
  62. > \ raise exception 'delete on base_relvar_metadata violates transition constraint base_relvar_metadata_d_readonly';\n\
  63. > \ end if;\n\
  64. > \ return null;\n\
  65. > \end;\n\
  66. > \$a$ language plpgsql volatile;\n\
  67. > \create function check_stuff_u_readonly() returns trigger as $a$\n\
  68. > \begin\n\
  69. > \ if (not (false)) then\n\
  70. > \ raise exception 'delete on base_relvar_metadata violates transition constraint base_relvar_metadata_d_readonly';\n\
  71. > \ end if;\n\
  72. > \ return null;\n\
  73. > \end;\n\
  74. > \$a$ language plpgsql volatile;"
  75. >
  76. > ,t createClientActionWrapper
  77. > "select create_client_action_wrapper('actname', $$actcall()$$);"
  78. > "create function action_actname() returns void as $a$\n\
  79. > \begin\n\
  80. > \ perform action_actcall();\n\
  81. > \end;\n\
  82. > \$a$ language plpgsql;"
  83. > ,t createClientActionWrapper
  84. > "select create_client_action_wrapper('actname', $$actcall('test')$$);"
  85. > "create function action_actname() returns void as $a$\n\
  86. > \begin\n\
  87. > \ perform action_actcall('test');\n\
  88. > \end;\n\
  89. > \$a$ language plpgsql;"
  90. > ,t addNotifyTriggers
  91. > "select set_relvar_type('stuff','data');"
  92. > "create function stuff_changed() returns trigger as $a$\n\
  93. > \begin\n\
  94. > \ notify stuff;\n\
  95. > \ return null;\n\
  96. > \end;\n\
  97. > \$a$ language plpgsql;"
  98. > ,t addConstraint
  99. > "select add_constraint('name', 'true', array['t1', 't2']);"
  100. > "create function check_con_name() returns boolean as $a$\n\
  101. > \begin\n\
  102. > \ return true;\n\
  103. > \end;\n\
  104. > \$a$ language plpgsql stable;\n\
  105. > \drop function if exists t1_constraint_trigger_operator();\n\
  106. > \create function t1_constraint_trigger_operator() returns trigger as $a$\n\
  107. > \begin\n\
  108. > \ null;\n\
  109. > \end;\n\
  110. > \$a$ language plpgsql;\n\
  111. > \drop function if exists t2_constraint_trigger_operator();\n\
  112. > \create function t2_constraint_trigger_operator() returns trigger as $a$\n\
  113. > \begin\n\
  114. > \ null;\n\
  115. > \end;\n\
  116. > \$a$ language plpgsql;"
  117. > ,t addKey
  118. > "select add_key('tbl', 'attr');"
  119. > "create function check_con_tbl_attr_key() returns boolean as $a$\n\
  120. > \begin\n\
  121. > \ return true;\n\
  122. > \end;\n\
  123. > \$a$ language plpgsql stable;\n\
  124. > \/*drop function if exists tbl_constraint_trigger_operator();\n\
  125. > \create function tbl_constraint_trigger_operator() returns trigger as $a$\n\
  126. > \begin\n\
  127. > \ null;\n\
  128. > \end;\n\
  129. > \$a$ language plpgsql;*/"
  130. > ,t addKey
  131. > "select add_key('tbl', array['attr1','attr2']);"
  132. > "create function check_con_tbl_attr1_attr2_key() returns boolean as $a$\n\
  133. > \begin\n\
  134. > \ return true;\n\
  135. > \end;\n\
  136. > \$a$ language plpgsql stable;\n\
  137. > \/*drop function if exists tbl_constraint_trigger_operator();\n\
  138. > \create function tbl_constraint_trigger_operator() returns trigger as $a$\n\
  139. > \begin\n\
  140. > \ null;\n\
  141. > \end;\n\
  142. > \$a$ language plpgsql;*/"
  143. > ,t zeroOneTuple
  144. > "select constrain_to_zero_or_one_tuple('tbl');"
  145. > "create function check_con_tbl_01_tuple() returns boolean as $a$\n\
  146. > \begin\n\
  147. > \ return true;\n\
  148. > \end;\n\
  149. > \$a$ language plpgsql stable;\n\
  150. > \drop function if exists tbl_constraint_trigger_operator();\n\
  151. > \create function tbl_constraint_trigger_operator() returns trigger as $a$\n\
  152. > \begin\n\
  153. > \ null;\n\
  154. > \end;\n\
  155. > \$a$ language plpgsql;"
  156. >
  157. > -- add_foreign_key
  158. > -- constrain zero one
  159. > -- add constraint
  160. >
  161. > ])
  162. >
  163. > where
  164. > t a b c = (a,b,c)
  165. > mapCheckExtension = map (\(a,b,c) -> checkExtension a b c)
  166. > checkExtension :: (StatementList -> StatementList) -> String -> String -> Test.Framework.Test
  167. > checkExtension f stxt ttxt = testCase ("check " ++ stxt) $
  168. > case (do
  169. > sast <- parseSql "" stxt
  170. > let esast = f sast
  171. > --trace (printSql esast) $ return ()
  172. > tast <- parseSql "" ttxt
  173. > return (tast,esast)) of
  174. > Left e -> assertFailure $ show e
  175. > Right (ts,es) -> assertEqual "" (stripAnnotations ts) (stripAnnotations es)