Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Initial commit

  • Loading branch information...
commit daaafffed3f4f1c59d39a9ec6e7712b6cc4a55c5 0 parents
@alsonkemp authored
Showing with 10,421 additions and 0 deletions.
  1. +6 −0 App/Controllers/About.hs
  2. +6 −0 App/Controllers/Develop.hs
  3. +6 −0 App/Controllers/Download.hs
  4. +6 −0 App/Controllers/Home.hs
  5. +6 −0 App/Layouts/Default.hs
  6. +64 −0 App/Layouts/oldDefault.hs
  7. +21 −0 App/Views/About/Index.hs
  8. +43 −0 App/Views/Develop/Index.hs
  9. +11 −0 App/Views/Download/Index.hs
  10. +17 −0 App/Views/Home/Index.hs
  11. +7 −0 App/Views/Source.hs
  12. +23 −0 Config/App.hs
  13. +41 −0 Config/Master.hs
  14. +6 −0 Config/Routes.hs
  15. +599 −0 Config/mime.types
  16. +1 −0  README
  17. +4 −0 Setup.lhs
  18. +40 −0 Turbinado/Controller.hs
  19. +32 −0 Turbinado/Controller/Exception.hs
  20. +47 −0 Turbinado/Controller/Monad.hs
  21. +38 −0 Turbinado/Database/ORM/Generator.hs
  22. +230 −0 Turbinado/Database/ORM/Output.hs
  23. +21 −0 Turbinado/Database/ORM/PostgreSQL.hs
  24. +30 −0 Turbinado/Environment.hs
  25. BIN  Turbinado/Environment/.ViewData.hs.swp
  26. +195 −0 Turbinado/Environment/CodeStore.hs
  27. +133 −0 Turbinado/Environment/Cookie.hs
  28. +5 −0 Turbinado/Environment/Header.hs
  29. +40 −0 Turbinado/Environment/Logger.hs
  30. +113 −0 Turbinado/Environment/MimeTypes.hs
  31. +138 −0 Turbinado/Environment/Request.hs
  32. +150 −0 Turbinado/Environment/Response.hs
  33. +88 −0 Turbinado/Environment/Routes.hs
  34. +132 −0 Turbinado/Environment/Session.hs
  35. +64 −0 Turbinado/Environment/Settings.hs
  36. +27 −0 Turbinado/Environment/ViewData.hs
  37. +43 −0 Turbinado/Layout.hs
  38. +175 −0 Turbinado/Server.hs
  39. +42 −0 Turbinado/Server/Exception.hs
  40. +44 −0 Turbinado/Server/Handlers/ErrorHandler.hs
  41. +106 −0 Turbinado/Server/Handlers/RequestHandler.hs
  42. +26 −0 Turbinado/Server/Handlers/SessionHandler.hs
  43. +159 −0 Turbinado/Server/Handlers/SessionHandlers/GenericDB.hs
  44. +30 −0 Turbinado/Server/Handlers/SessionHandlers/GenericDB/SessionDBInfo.hs
  45. +68 −0 Turbinado/Server/Handlers/SessionHandlers/GenericDB/SessionDBInfo/SessionData.hs
  46. +42 −0 Turbinado/Server/Handlers/SessionHandlers/GenericDB/SessionDBInfo/Sessions.hs
  47. +17 −0 Turbinado/Server/Handlers/SessionHandlers/PostgreSQL.hs.in
  48. +115 −0 Turbinado/Server/Handlers/SessionHandlers/Simple.hs
  49. +25 −0 Turbinado/Server/Network.hs
  50. +60 −0 Turbinado/Server/StandardResponse.hs
  51. +42 −0 Turbinado/Server/StaticContent.hs
  52. +7 −0 Turbinado/Stubs/Common.hs
  53. +3 −0  Turbinado/Stubs/Controller.hs
  54. +9 −0 Turbinado/Stubs/Layout.hs
  55. +11 −0 Turbinado/Stubs/View.hs
  56. +27 −0 Turbinado/Utility/General.hs
  57. +110 −0 Turbinado/View.hs
  58. +32 −0 Turbinado/View/Exception.hs
  59. +132 −0 Turbinado/View/HTML.hs
  60. +57 −0 Turbinado/View/Monad.hs
  61. +129 −0 Turbinado/View/XML.hs
  62. +78 −0 Turbinado/View/XML/PCDATA.hs
  63. +215 −0 Turbinado/View/XMLGenerator.hs
  64. +5 −0 build
  65. +1 −0  log/log
  66. +25 −0 static/css/blueprintcss/ie.css
  67. +30 −0 static/css/blueprintcss/print.css
  68. +251 −0 static/css/blueprintcss/screen.css
  69. +3 −0  static/css/extjs/css/README.txt
  70. +61 −0 static/css/extjs/css/borders.css
  71. +111 −0 static/css/extjs/css/box.css
  72. +161 −0 static/css/extjs/css/button.css
  73. +55 −0 static/css/extjs/css/combo.css
  74. +314 −0 static/css/extjs/css/core.css
  75. +247 −0 static/css/extjs/css/date-picker.css
  76. +75 −0 static/css/extjs/css/dd.css
  77. +37 −0 static/css/extjs/css/debug.css
  78. +69 −0 static/css/extjs/css/dialog.css
  79. +66 −0 static/css/extjs/css/editor.css
  80. +925 −0 static/css/extjs/css/ext-all.css
  81. +552 −0 static/css/extjs/css/form.css
  82. +554 −0 static/css/extjs/css/grid.css
  83. +273 −0 static/css/extjs/css/layout.css
  84. +142 −0 static/css/extjs/css/menu.css
  85. +424 −0 static/css/extjs/css/panel.css
  86. +43 −0 static/css/extjs/css/progress.css
  87. +134 −0 static/css/extjs/css/qtips.css
  88. +9 −0 static/css/extjs/css/reset-min.css
  89. +9 −0 static/css/extjs/css/reset.css
  90. +143 −0 static/css/extjs/css/resizable.css
  91. +90 −0 static/css/extjs/css/slider.css
  92. +358 −0 static/css/extjs/css/tabs.css
  93. +183 −0 static/css/extjs/css/toolbar.css
  94. +254 −0 static/css/extjs/css/tree.css
  95. +208 −0 static/css/extjs/css/window.css
  96. +415 −0 static/css/extjs/css/xtheme-gray.css
  97. BIN  static/css/extjs/images/default/box/corners-blue.gif
  98. BIN  static/css/extjs/images/default/box/corners.gif
  99. BIN  static/css/extjs/images/default/box/l-blue.gif
  100. BIN  static/css/extjs/images/default/box/l.gif
  101. BIN  static/css/extjs/images/default/box/r-blue.gif
  102. BIN  static/css/extjs/images/default/box/r.gif
  103. BIN  static/css/extjs/images/default/box/tb-blue.gif
  104. BIN  static/css/extjs/images/default/box/tb.gif
  105. BIN  static/css/extjs/images/default/button/btn-arrow.gif
  106. BIN  static/css/extjs/images/default/button/btn-sprite.gif
  107. BIN  static/css/extjs/images/default/dd/drop-add.gif
  108. BIN  static/css/extjs/images/default/dd/drop-no.gif
  109. BIN  static/css/extjs/images/default/dd/drop-yes.gif
  110. BIN  static/css/extjs/images/default/editor/tb-sprite.gif
  111. BIN  static/css/extjs/images/default/form/checkbox.gif
  112. BIN  static/css/extjs/images/default/form/clear-trigger.gif
  113. BIN  static/css/extjs/images/default/form/clear-trigger.psd
  114. BIN  static/css/extjs/images/default/form/date-trigger.gif
  115. BIN  static/css/extjs/images/default/form/date-trigger.psd
  116. BIN  static/css/extjs/images/default/form/error-tip-corners.gif
  117. BIN  static/css/extjs/images/default/form/exclamation.gif
  118. BIN  static/css/extjs/images/default/form/radio.gif
  119. BIN  static/css/extjs/images/default/form/search-trigger.gif
  120. BIN  static/css/extjs/images/default/form/search-trigger.psd
  121. BIN  static/css/extjs/images/default/form/text-bg.gif
  122. BIN  static/css/extjs/images/default/form/trigger-tpl.gif
  123. BIN  static/css/extjs/images/default/form/trigger.gif
  124. BIN  static/css/extjs/images/default/form/trigger.psd
  125. BIN  static/css/extjs/images/default/gradient-bg.gif
  126. BIN  static/css/extjs/images/default/grid/arrow-left-white.gif
  127. BIN  static/css/extjs/images/default/grid/arrow-right-white.gif
  128. BIN  static/css/extjs/images/default/grid/col-move-bottom.gif
  129. BIN  static/css/extjs/images/default/grid/col-move-top.gif
  130. BIN  static/css/extjs/images/default/grid/columns.gif
  131. BIN  static/css/extjs/images/default/grid/dirty.gif
  132. BIN  static/css/extjs/images/default/grid/done.gif
  133. BIN  static/css/extjs/images/default/grid/drop-no.gif
  134. BIN  static/css/extjs/images/default/grid/drop-yes.gif
  135. BIN  static/css/extjs/images/default/grid/footer-bg.gif
  136. BIN  static/css/extjs/images/default/grid/grid-blue-hd.gif
  137. BIN  static/css/extjs/images/default/grid/grid-blue-split.gif
  138. BIN  static/css/extjs/images/default/grid/grid-hrow.gif
  139. BIN  static/css/extjs/images/default/grid/grid-loading.gif
  140. BIN  static/css/extjs/images/default/grid/grid-split.gif
  141. BIN  static/css/extjs/images/default/grid/grid-vista-hd.gif
  142. BIN  static/css/extjs/images/default/grid/grid3-hd-btn.gif
  143. BIN  static/css/extjs/images/default/grid/grid3-hrow-over.gif
  144. BIN  static/css/extjs/images/default/grid/grid3-hrow.gif
  145. BIN  static/css/extjs/images/default/grid/grid3-special-col-bg.gif
  146. BIN  static/css/extjs/images/default/grid/grid3-special-col-sel-bg.gif
  147. BIN  static/css/extjs/images/default/grid/group-by.gif
  148. BIN  static/css/extjs/images/default/grid/group-expand-sprite.gif
  149. BIN  static/css/extjs/images/default/grid/hd-pop.gif
  150. BIN  static/css/extjs/images/default/grid/hmenu-asc.gif
  151. BIN  static/css/extjs/images/default/grid/hmenu-desc.gif
  152. BIN  static/css/extjs/images/default/grid/hmenu-lock.gif
  153. BIN  static/css/extjs/images/default/grid/hmenu-lock.png
  154. BIN  static/css/extjs/images/default/grid/hmenu-unlock.gif
  155. BIN  static/css/extjs/images/default/grid/hmenu-unlock.png
  156. BIN  static/css/extjs/images/default/grid/invalid_line.gif
  157. BIN  static/css/extjs/images/default/grid/loading.gif
  158. BIN  static/css/extjs/images/default/grid/mso-hd.gif
  159. BIN  static/css/extjs/images/default/grid/nowait.gif
  160. BIN  static/css/extjs/images/default/grid/page-first-disabled.gif
  161. BIN  static/css/extjs/images/default/grid/page-first.gif
  162. BIN  static/css/extjs/images/default/grid/page-last-disabled.gif
  163. BIN  static/css/extjs/images/default/grid/page-last.gif
  164. BIN  static/css/extjs/images/default/grid/page-next-disabled.gif
  165. BIN  static/css/extjs/images/default/grid/page-next.gif
  166. BIN  static/css/extjs/images/default/grid/page-prev-disabled.gif
  167. BIN  static/css/extjs/images/default/grid/page-prev.gif
  168. BIN  static/css/extjs/images/default/grid/pick-button.gif
  169. BIN  static/css/extjs/images/default/grid/refresh.gif
  170. BIN  static/css/extjs/images/default/grid/row-check-sprite.gif
  171. BIN  static/css/extjs/images/default/grid/row-expand-sprite.gif
  172. BIN  static/css/extjs/images/default/grid/row-over.gif
  173. BIN  static/css/extjs/images/default/grid/row-sel.gif
  174. BIN  static/css/extjs/images/default/grid/sort_asc.gif
  175. BIN  static/css/extjs/images/default/grid/sort_desc.gif
  176. BIN  static/css/extjs/images/default/grid/wait.gif
  177. BIN  static/css/extjs/images/default/layout/collapse.gif
  178. BIN  static/css/extjs/images/default/layout/expand.gif
  179. BIN  static/css/extjs/images/default/layout/gradient-bg.gif
  180. BIN  static/css/extjs/images/default/layout/mini-bottom.gif
  181. BIN  static/css/extjs/images/default/layout/mini-left.gif
  182. BIN  static/css/extjs/images/default/layout/mini-right.gif
  183. BIN  static/css/extjs/images/default/layout/mini-top.gif
  184. BIN  static/css/extjs/images/default/layout/ns-collapse.gif
  185. BIN  static/css/extjs/images/default/layout/ns-expand.gif
  186. BIN  static/css/extjs/images/default/layout/panel-close.gif
  187. BIN  static/css/extjs/images/default/layout/panel-title-bg.gif
  188. BIN  static/css/extjs/images/default/layout/panel-title-light-bg.gif
  189. BIN  static/css/extjs/images/default/layout/stick.gif
  190. BIN  static/css/extjs/images/default/layout/stuck.gif
  191. BIN  static/css/extjs/images/default/layout/tab-close-on.gif
  192. BIN  static/css/extjs/images/default/layout/tab-close.gif
  193. BIN  static/css/extjs/images/default/menu/checked.gif
  194. BIN  static/css/extjs/images/default/menu/group-checked.gif
  195. BIN  static/css/extjs/images/default/menu/item-over.gif
  196. BIN  static/css/extjs/images/default/menu/menu-parent.gif
  197. BIN  static/css/extjs/images/default/menu/menu.gif
  198. BIN  static/css/extjs/images/default/menu/unchecked.gif
  199. BIN  static/css/extjs/images/default/panel/corners-sprite.gif
  200. BIN  static/css/extjs/images/default/panel/left-right.gif
  201. BIN  static/css/extjs/images/default/panel/light-hd.gif
  202. BIN  static/css/extjs/images/default/panel/tool-sprite-tpl.gif
  203. BIN  static/css/extjs/images/default/panel/tool-sprites.gif
  204. BIN  static/css/extjs/images/default/panel/tools-sprites-trans.gif
  205. BIN  static/css/extjs/images/default/panel/top-bottom.gif
  206. BIN  static/css/extjs/images/default/panel/top-bottom.png
  207. BIN  static/css/extjs/images/default/panel/white-corners-sprite.gif
  208. BIN  static/css/extjs/images/default/panel/white-left-right.gif
  209. BIN  static/css/extjs/images/default/panel/white-top-bottom.gif
  210. BIN  static/css/extjs/images/default/progress/progress-bg.gif
  211. BIN  static/css/extjs/images/default/qtip/bg.gif
  212. BIN  static/css/extjs/images/default/qtip/close.gif
  213. BIN  static/css/extjs/images/default/qtip/tip-sprite.gif
  214. BIN  static/css/extjs/images/default/s.gif
  215. BIN  static/css/extjs/images/default/shadow-c.png
  216. BIN  static/css/extjs/images/default/shadow-c.psd
  217. BIN  static/css/extjs/images/default/shadow-lr.png
  218. BIN  static/css/extjs/images/default/shadow.png
  219. BIN  static/css/extjs/images/default/shared/blue-loading.gif
  220. BIN  static/css/extjs/images/default/shared/calendar.gif
  221. BIN  static/css/extjs/images/default/shared/glass-bg.gif
  222. BIN  static/css/extjs/images/default/shared/hd-sprite.gif
  223. BIN  static/css/extjs/images/default/shared/large-loading.gif
  224. BIN  static/css/extjs/images/default/shared/left-btn.gif
  225. BIN  static/css/extjs/images/default/shared/loading-balls.gif
  226. BIN  static/css/extjs/images/default/shared/right-btn.gif
  227. BIN  static/css/extjs/images/default/shared/warning.gif
  228. BIN  static/css/extjs/images/default/sizer/e-handle-dark.gif
  229. BIN  static/css/extjs/images/default/sizer/e-handle.gif
  230. BIN  static/css/extjs/images/default/sizer/ne-handle-dark.gif
  231. BIN  static/css/extjs/images/default/sizer/ne-handle.gif
  232. BIN  static/css/extjs/images/default/sizer/nw-handle-dark.gif
  233. BIN  static/css/extjs/images/default/sizer/nw-handle.gif
  234. BIN  static/css/extjs/images/default/sizer/s-handle-dark.gif
  235. BIN  static/css/extjs/images/default/sizer/s-handle.gif
  236. BIN  static/css/extjs/images/default/sizer/se-handle-dark.gif
  237. BIN  static/css/extjs/images/default/sizer/se-handle.gif
  238. BIN  static/css/extjs/images/default/sizer/square.gif
  239. BIN  static/css/extjs/images/default/sizer/sw-handle-dark.gif
  240. BIN  static/css/extjs/images/default/sizer/sw-handle.gif
  241. BIN  static/css/extjs/images/default/slider/slider-bg.png
  242. BIN  static/css/extjs/images/default/slider/slider-thumb.png
  243. BIN  static/css/extjs/images/default/slider/slider-v-bg.png
  244. BIN  static/css/extjs/images/default/slider/slider-v-thumb.png
  245. BIN  static/css/extjs/images/default/tabs/scroll-left.gif
  246. BIN  static/css/extjs/images/default/tabs/scroll-right.gif
  247. BIN  static/css/extjs/images/default/tabs/scroller-bg.gif
  248. BIN  static/css/extjs/images/default/tabs/tab-btm-inactive-left-bg.gif
  249. BIN  static/css/extjs/images/default/tabs/tab-btm-inactive-right-bg.gif
  250. BIN  static/css/extjs/images/default/tabs/tab-btm-left-bg.gif
  251. BIN  static/css/extjs/images/default/tabs/tab-btm-right-bg.gif
  252. BIN  static/css/extjs/images/default/tabs/tab-close.gif
  253. BIN  static/css/extjs/images/default/tabs/tab-strip-bg.gif
  254. BIN  static/css/extjs/images/default/tabs/tab-strip-bg.png
  255. BIN  static/css/extjs/images/default/tabs/tab-strip-btm-bg.gif
  256. BIN  static/css/extjs/images/default/tabs/tabs-sprite.gif
  257. BIN  static/css/extjs/images/default/toolbar/bg.gif
  258. BIN  static/css/extjs/images/default/toolbar/btn-arrow-light.gif
  259. BIN  static/css/extjs/images/default/toolbar/btn-arrow.gif
  260. BIN  static/css/extjs/images/default/toolbar/btn-over-bg.gif
  261. BIN  static/css/extjs/images/default/toolbar/gray-bg.gif
  262. BIN  static/css/extjs/images/default/toolbar/tb-bg.gif
  263. BIN  static/css/extjs/images/default/toolbar/tb-btn-sprite.gif
  264. BIN  static/css/extjs/images/default/tree/arrows.gif
  265. BIN  static/css/extjs/images/default/tree/drop-add.gif
  266. BIN  static/css/extjs/images/default/tree/drop-between.gif
  267. BIN  static/css/extjs/images/default/tree/drop-no.gif
  268. BIN  static/css/extjs/images/default/tree/drop-over.gif
  269. BIN  static/css/extjs/images/default/tree/drop-under.gif
  270. BIN  static/css/extjs/images/default/tree/drop-yes.gif
  271. BIN  static/css/extjs/images/default/tree/elbow-end-minus-nl.gif
  272. BIN  static/css/extjs/images/default/tree/elbow-end-minus.gif
  273. BIN  static/css/extjs/images/default/tree/elbow-end-plus-nl.gif
  274. BIN  static/css/extjs/images/default/tree/elbow-end-plus.gif
  275. BIN  static/css/extjs/images/default/tree/elbow-end.gif
  276. BIN  static/css/extjs/images/default/tree/elbow-line.gif
  277. BIN  static/css/extjs/images/default/tree/elbow-minus-nl.gif
  278. BIN  static/css/extjs/images/default/tree/elbow-minus.gif
  279. BIN  static/css/extjs/images/default/tree/elbow-plus-nl.gif
  280. BIN  static/css/extjs/images/default/tree/elbow-plus.gif
  281. BIN  static/css/extjs/images/default/tree/elbow.gif
  282. BIN  static/css/extjs/images/default/tree/folder-open.gif
  283. BIN  static/css/extjs/images/default/tree/folder.gif
  284. BIN  static/css/extjs/images/default/tree/leaf.gif
  285. BIN  static/css/extjs/images/default/tree/loading.gif
  286. BIN  static/css/extjs/images/default/tree/s.gif
  287. BIN  static/css/extjs/images/default/window/icon-error.gif
  288. BIN  static/css/extjs/images/default/window/icon-info.gif
  289. BIN  static/css/extjs/images/default/window/icon-question.gif
  290. BIN  static/css/extjs/images/default/window/icon-warning.gif
  291. BIN  static/css/extjs/images/default/window/left-corners.png
  292. BIN  static/css/extjs/images/default/window/left-corners.psd
  293. BIN  static/css/extjs/images/default/window/left-right.png
  294. BIN  static/css/extjs/images/default/window/left-right.psd
  295. BIN  static/css/extjs/images/default/window/right-corners.png
  296. BIN  static/css/extjs/images/default/window/right-corners.psd
  297. BIN  static/css/extjs/images/default/window/top-bottom.png
  298. BIN  static/css/extjs/images/default/window/top-bottom.psd
  299. BIN  static/css/extjs/images/gray/button/btn-arrow.gif
  300. BIN  static/css/extjs/images/gray/button/btn-sprite.gif
Sorry, we could not display the entire diff because too many files (424) changed.
6 App/Controllers/About.hs
@@ -0,0 +1,6 @@
+module About (index) where
+
+index :: Controller ()
+index = return ()
+
+
6 App/Controllers/Develop.hs
@@ -0,0 +1,6 @@
+module Develop (index) where
+
+index :: Controller ()
+index = return ()
+
+
6 App/Controllers/Download.hs
@@ -0,0 +1,6 @@
+module Download (index) where
+
+index :: Controller ()
+index = return ()
+
+
6 App/Controllers/Home.hs
@@ -0,0 +1,6 @@
+module Home (index) where
+
+index :: Controller ()
+index = return () :: Controller ()
+
+
6 App/Layouts/Default.hs
@@ -0,0 +1,6 @@
+module Default (page) where
+
+-- This is for XML, so doesn't do anything but insert the page
+page :: View XML
+page = insertView
+
64 App/Layouts/oldDefault.hs
@@ -0,0 +1,64 @@
+module Default (page) where
+import qualified Network.URI as URI
+import qualified Network.HTTP as HTTP
+
+page :: View XML
+page = <html>
+ <head>
+ <% styleSheet "extjs/css/ext-all" "screen"%>
+ <% styleSheet "turbinado" "screen"%>
+
+ <% javaScript "extjs/adapter/ext/ext-base" %>
+ <% javaScript "ext-all" %>
+ <% googleAnalytics "UA-6158816-1" %>
+
+ <script type="text/javascript">
+ Ext.onReady(function(){
+ var tabs = new Ext.TabPanel({
+ renderTo: 'content-block',
+ //width:450,
+ activeTab: 0,
+ frame:true,
+ autoHeight: true,
+ autoWidth: true,
+ layout: 'fit',
+ defaults:{autoHeight: true},
+ items:[
+ {autoLoad: '/Home/Index.xml', title: 'Home'}
+ , {autoLoad: '/Develop/Index.xml', title: 'Develop'}
+ , {autoLoad: '/Tutorial/Index.xml', title: 'Tutorial'}
+ , {autoLoad: '/Code/Index.xml', title: 'Code'}
+ ]
+ });
+ });
+ </script>
+ </head>
+ <body>
+ <div class="wrapper">
+ <div class="title">
+ <h1 style="display: inline">Turbinado</h1>
+ <h2 style="display: inline">web sugar</h2>
+ </div>
+ <hr />
+ <div class="container">
+ <div id="content-block" class="content-block">
+ </div>
+ </div>
+ <hr id="hr-footer" />
+ <div class="footer">
+ Footer
+ </div>
+ </div>
+ </body>
+ </html>
+
+anchorWithImage :: String -> String -> View XML
+anchorWithImage l i = <a href=l>
+ <img src=i height="100" />
+ </a>
+
+anchorWithText :: String -> String -> View XML
+anchorWithText l t = <a href=l>
+ <% t %>
+ </a>
+
21 App/Views/About/Index.hs
@@ -0,0 +1,21 @@
+onRender = <div>
+ <h2>Features</h2>
+ <p>Turbinado gives you all of the benefits of coding in Haskell and adds:</p>
+ <ul class="standard-list">
+ <li> Automagic recompilation of Layouts, Pages and Controls; </li>
+ <li> A database <% anchorTag "http://en.wikipedia.org/wiki/Object-relational_mapping" "ORM" %> to make database interaction (especially with PostgreSQL) joyful; </li>
+ <li> A rich set of tags to make designing pages simpler;. </li>
+ </ul>
+
+ <h2>... On The Backs of Giants ... </h2>
+ <p>Turbinado wouldn't be possible without the original work of the following people:</p>
+ <ul class="standard-list">
+ <li> <% anchorTag "http://www.cs.chalmers.se/~d00nibro/" "Niklas Broberg" %> for Haskell Server Pages, the HSP Runtime, Haskell Source Extensions and Haskell Regular Expressions</li>
+ <li> <% anchorTag "http://www.cse.unsw.edu.au/~dons/hs-plugins/" "Don Stewart" %> for hs-plugins </li>
+ <li> <% anchorTag "http://www.cs.chalmers.se/~bringert/projects.html" "Bjorn Bringert" %> for HTTP </li>
+ <li> <% anchorTag "http://software.complete.org/software/projects/show/hdbc" "John Goerzen" %> for Haskell Database Connectivity.</li>
+ <li> <% anchorTag "http://software.complete.org/software/projects/show/hdbc" "John Goerzen" %> for Haskell Database Connectivity.</li>
+
+ </ul>
+
+ </div>
43 App/Views/Develop/Index.hs
@@ -0,0 +1,43 @@
+module Index (page) where
+
+page :: View XML
+page = <div>
+ <h2>! Windows</h2>
+ <p>This software doesn't work on Windows. Linux/Unix only at this point.</p>
+
+ <h2>Darcs</h2>
+ <p> The <em>darcs</em> repo is at <% anchorTag "http://darcs.turbinado.org" "darcs.turbinado.org" %>. Send commits to maintainer@turbinado.org</p>
+
+ <h2>Dependencies</h2>
+ <p>You'll need the following:</p>
+ <ul class="standard-list">
+ <li><% anchorTag "http://www.haskell.org/ghc" "GHC" %>
+ <em> (darcs) </em>
+ </li>
+
+ <li><% anchorTag "http://code.haskell.org/HSP/haskell-src-exts/" "haskell-src-exts" %>
+ <em> (darcs) </em>
+ </li>
+
+ <li><% anchorTag "http://code.haskell.org/HSP/harp/" "harp" %>
+ <em> (darcs) </em>
+ </li>
+
+ <li><% anchorTag "http://git.complete.org/hslogger" "hslogger" %>
+ <em> (git) </em>
+ </li>
+
+ <li><% anchorTag "http://code.haskell.org/HSP/hsx/" "hsx" %>
+ <em> (darcs) </em>
+ </li>
+
+ <li><% anchorTag "http://code.haskell.org/hs-plugins" "hs-plugins" %>
+ <em> (darcs) </em>
+ </li>
+
+ <li><% anchorTag "http://code.haskell.org/http" "http" %>
+ <em> (darcs) </em>
+ </li>
+
+ </ul>
+ </div>
11 App/Views/Download/Index.hs
@@ -0,0 +1,11 @@
+module Index (page) where
+
+page :: View XML
+page = <div>
+ <h2>DANGER WILL ROBINSON</h2>
+ <p>Developers only at this point!</p>
+ <p>That said, we're looking for help. Interested? Check out the
+ <% anchorTag "/Develop" "Development" %> section. Grab the code, look it over and tell us
+ how you would improve it.
+ </p>
+ </div>
17 App/Views/Home/Index.hs
@@ -0,0 +1,17 @@
+module Index (page) where
+
+import System.Time
+
+page :: View XML
+page = <div>
+ <h2>Turbinado?</h2>
+ <div style="float:right">
+ <img src="http://upload.wikimedia.org/wikipedia/en/thumb/0/0e/TurbinadoSugar.jpg/757px-TurbinadoSugar.jpg" width="300" />
+ </div>
+ <p> <a href="http://en.wikipedia.org/wiki/Turbinado">Turbinado</a> is that yummy, not-so-refined sugar.
+ Sounds like Haskell... Sounds like this framework...</p>
+ <p> Turbinado is also an easy-to-use web application framework for Haskell.</p>
+
+ <h2>Why</h2>
+ <p>Haskell has no easy-to-use web framework. Turbinado is an effort to build one by lazily stealing the best ideas from <% anchorTag "www.rubyonrails.org" "Ruby On Rails" %>, <% anchorTag "www.asp.net" "ASP.NET" %>, etc.</p>
+ </div>
7 App/Views/Source.hs
@@ -0,0 +1,7 @@
+import System.Time
+
+onRender = <div>
+ <pre>
+
+ </pre>
+ </div>
23 Config/App.hs
@@ -0,0 +1,23 @@
+module Config.App where
+
+import System.Log.Logger
+
+----------------------------------------------------------------
+-- Environment settings
+----------------------------------------------------------------
+applicationPath = ""
+applicationHost = "localhost:8080"
+
+----------------------------------------------------------------
+-- RequestHandler Filter List additions
+----------------------------------------------------------------
+customPreFilters = []
+customPostFilters = []
+
+
+----------------------------------------------------------------
+-- Logging
+----------------------------------------------------------------
+logLevel = DEBUG -- DEBUG < INFO < NOTICE < WARNING < ERROR < CRITICAL < ALERT < EMERGENCY
+
+
41 Config/Master.hs
@@ -0,0 +1,41 @@
+module Config.Master (
+ module Config.Master,
+ module Config.App,
+ Turbinado.Server.Handlers.SessionHandlers.Simple.getSessionHandler
+ ) where
+
+import Turbinado.Server.Handlers.SessionHandlers.Simple
+import Config.App
+
+----------------------------------------------------------------
+-- Arguments to the make system used in the Dynamic Loader
+----------------------------------------------------------------
+
+compileArgs =
+ [ "-fglasgow-exts"
+ , "-fallow-overlapping-instances"
+ , "-fallow-undecidable-instances"
+ , "-F", "-pgmFtrhsx"
+ , "-fno-warn-overlapping-patterns"
+ ] ++ (map ("-i"++) searchDirs)
+
+mUserPkgConf = [""]
+
+----------------------------------------------------------------
+-- Paths
+----------------------------------------------------------------
+
+viewDir = "App/Views"
+viewStub = "Turbinado/Stubs/View.hs"
+layoutDir = "App/Layouts"
+layoutStub = "Turbinado/Stubs/Layout.hs"
+controllerDir = "App/Controllers"
+controllerStub = "Turbinado/Stubs/Controller.hs"
+
+configDir = "Config"
+searchDirs = [viewDir, layoutDir, controllerDir, rootDir, configDir, compiledDir]
+
+staticDirs = ["static", "tmp/cache"]
+compiledDir = "tmp/compiled"
+
+rootDir = "./"
6 Config/Routes.hs
@@ -0,0 +1,6 @@
+module Config.Routes where
+
+routes = [ "/:controller/:action.:format"
+ , "/:controller/:action"
+ , "/:controller"
+ ]
599 Config/mime.types
@@ -0,0 +1,599 @@
+# This is a comment. I love comments.
+
+# This file controls what Internet media types are sent to the client for
+# given file extension(s). Sending the correct media type to the client
+# is important so they know how to handle the content of the file.
+# Extra types can either be added here or by using an AddType directive
+# in your config files. For more information about Internet media types,
+# please read RFC 2045, 2046, 2047, 2048, and 2077. The Internet media type
+# registry is at <http://www.iana.org/assignments/media-types/>.
+
+# MIME type Extensions
+application/activemessage
+application/andrew-inset ez
+application/applefile
+application/atom+xml atom
+application/atomicmail
+application/batch-smtp
+application/beep+xml
+application/cals-1840
+application/cnrp+xml
+application/commonground
+application/cpl+xml
+application/cybercash
+application/dca-rft
+application/dec-dx
+application/dvcs
+application/edi-consent
+application/edifact
+application/edi-x12
+application/eshop
+application/font-tdpfr
+application/http
+application/hyperstudio
+application/iges
+application/index
+application/index.cmd
+application/index.obj
+application/index.response
+application/index.vnd
+application/iotp
+application/ipp
+application/isup
+application/mac-binhex40 hqx
+application/mac-compactpro cpt
+application/macwriteii
+application/marc
+application/mathematica
+application/mathml+xml mathml
+application/msword doc
+application/news-message-id
+application/news-transmission
+application/ocsp-request
+application/ocsp-response
+application/octet-stream bin dms lha lzh exe class so dll dmg
+application/oda oda
+application/ogg ogg
+application/parityfec
+application/pdf pdf
+application/pgp-encrypted
+application/pgp-keys
+application/pgp-signature
+application/pkcs10
+application/pkcs7-mime
+application/pkcs7-signature
+application/pkix-cert
+application/pkix-crl
+application/pkixcmp
+application/postscript ai eps ps
+application/prs.alvestrand.titrax-sheet
+application/prs.cww
+application/prs.nprend
+application/prs.plucker
+application/qsig
+application/rdf+xml rdf
+application/reginfo+xml
+application/remote-printing
+application/riscos
+application/rtf
+application/sdp
+application/set-payment
+application/set-payment-initiation
+application/set-registration
+application/set-registration-initiation
+application/sgml
+application/sgml-open-catalog
+application/sieve
+application/slate
+application/smil smi smil
+application/srgs gram
+application/srgs+xml grxml
+application/timestamp-query
+application/timestamp-reply
+application/tve-trigger
+application/vemmi
+application/vnd.3gpp.pic-bw-large
+application/vnd.3gpp.pic-bw-small
+application/vnd.3gpp.pic-bw-var
+application/vnd.3gpp.sms
+application/vnd.3m.post-it-notes
+application/vnd.accpac.simply.aso
+application/vnd.accpac.simply.imp
+application/vnd.acucobol
+application/vnd.acucorp
+application/vnd.adobe.xfdf
+application/vnd.aether.imp
+application/vnd.amiga.ami
+application/vnd.anser-web-certificate-issue-initiation
+application/vnd.anser-web-funds-transfer-initiation
+application/vnd.audiograph
+application/vnd.blueice.multipass
+application/vnd.bmi
+application/vnd.businessobjects
+application/vnd.canon-cpdl
+application/vnd.canon-lips
+application/vnd.cinderella
+application/vnd.claymore
+application/vnd.commerce-battelle
+application/vnd.commonspace
+application/vnd.contact.cmsg
+application/vnd.cosmocaller
+application/vnd.criticaltools.wbs+xml
+application/vnd.ctc-posml
+application/vnd.cups-postscript
+application/vnd.cups-raster
+application/vnd.cups-raw
+application/vnd.curl
+application/vnd.cybank
+application/vnd.data-vision.rdz
+application/vnd.dna
+application/vnd.dpgraph
+application/vnd.dreamfactory
+application/vnd.dxr
+application/vnd.ecdis-update
+application/vnd.ecowin.chart
+application/vnd.ecowin.filerequest
+application/vnd.ecowin.fileupdate
+application/vnd.ecowin.series
+application/vnd.ecowin.seriesrequest
+application/vnd.ecowin.seriesupdate
+application/vnd.enliven
+application/vnd.epson.esf
+application/vnd.epson.msf
+application/vnd.epson.quickanime
+application/vnd.epson.salt
+application/vnd.epson.ssf
+application/vnd.ericsson.quickcall
+application/vnd.eudora.data
+application/vnd.fdf
+application/vnd.ffsns
+application/vnd.fints
+application/vnd.flographit
+application/vnd.framemaker
+application/vnd.fsc.weblaunch
+application/vnd.fujitsu.oasys
+application/vnd.fujitsu.oasys2
+application/vnd.fujitsu.oasys3
+application/vnd.fujitsu.oasysgp
+application/vnd.fujitsu.oasysprs
+application/vnd.fujixerox.ddd
+application/vnd.fujixerox.docuworks
+application/vnd.fujixerox.docuworks.binder
+application/vnd.fut-misnet
+application/vnd.grafeq
+application/vnd.groove-account
+application/vnd.groove-help
+application/vnd.groove-identity-message
+application/vnd.groove-injector
+application/vnd.groove-tool-message
+application/vnd.groove-tool-template
+application/vnd.groove-vcard
+application/vnd.hbci
+application/vnd.hhe.lesson-player
+application/vnd.hp-hpgl
+application/vnd.hp-hpid
+application/vnd.hp-hps
+application/vnd.hp-pcl
+application/vnd.hp-pclxl
+application/vnd.httphone
+application/vnd.hzn-3d-crossword
+application/vnd.ibm.afplinedata
+application/vnd.ibm.electronic-media
+application/vnd.ibm.minipay
+application/vnd.ibm.modcap
+application/vnd.ibm.rights-management
+application/vnd.ibm.secure-container
+application/vnd.informix-visionary
+application/vnd.intercon.formnet
+application/vnd.intertrust.digibox
+application/vnd.intertrust.nncp
+application/vnd.intu.qbo
+application/vnd.intu.qfx
+application/vnd.irepository.package+xml
+application/vnd.is-xpr
+application/vnd.japannet-directory-service
+application/vnd.japannet-jpnstore-wakeup
+application/vnd.japannet-payment-wakeup
+application/vnd.japannet-registration
+application/vnd.japannet-registration-wakeup
+application/vnd.japannet-setstore-wakeup
+application/vnd.japannet-verification
+application/vnd.japannet-verification-wakeup
+application/vnd.jisp
+application/vnd.kde.karbon
+application/vnd.kde.kchart
+application/vnd.kde.kformula
+application/vnd.kde.kivio
+application/vnd.kde.kontour
+application/vnd.kde.kpresenter
+application/vnd.kde.kspread
+application/vnd.kde.kword
+application/vnd.kenameaapp
+application/vnd.koan
+application/vnd.liberty-request+xml
+application/vnd.llamagraphics.life-balance.desktop
+application/vnd.llamagraphics.life-balance.exchange+xml
+application/vnd.lotus-1-2-3
+application/vnd.lotus-approach
+application/vnd.lotus-freelance
+application/vnd.lotus-notes
+application/vnd.lotus-organizer
+application/vnd.lotus-screencam
+application/vnd.lotus-wordpro
+application/vnd.mcd
+application/vnd.mediastation.cdkey
+application/vnd.meridian-slingshot
+application/vnd.micrografx.flo
+application/vnd.micrografx.igx
+application/vnd.mif mif
+application/vnd.minisoft-hp3000-save
+application/vnd.mitsubishi.misty-guard.trustweb
+application/vnd.mobius.daf
+application/vnd.mobius.dis
+application/vnd.mobius.mbk
+application/vnd.mobius.mqy
+application/vnd.mobius.msl
+application/vnd.mobius.plc
+application/vnd.mobius.txf
+application/vnd.mophun.application
+application/vnd.mophun.certificate
+application/vnd.motorola.flexsuite
+application/vnd.motorola.flexsuite.adsi
+application/vnd.motorola.flexsuite.fis
+application/vnd.motorola.flexsuite.gotap
+application/vnd.motorola.flexsuite.kmr
+application/vnd.motorola.flexsuite.ttc
+application/vnd.motorola.flexsuite.wem
+application/vnd.mozilla.xul+xml xul
+application/vnd.ms-artgalry
+application/vnd.ms-asf
+application/vnd.ms-excel xls
+application/vnd.ms-lrm
+application/vnd.ms-powerpoint ppt
+application/vnd.ms-project
+application/vnd.ms-tnef
+application/vnd.ms-works
+application/vnd.ms-wpl
+application/vnd.mseq
+application/vnd.msign
+application/vnd.music-niff
+application/vnd.musician
+application/vnd.netfpx
+application/vnd.noblenet-directory
+application/vnd.noblenet-sealer
+application/vnd.noblenet-web
+application/vnd.novadigm.edm
+application/vnd.novadigm.edx
+application/vnd.novadigm.ext
+application/vnd.obn
+application/vnd.osa.netdeploy
+application/vnd.palm
+application/vnd.pg.format
+application/vnd.pg.osasli
+application/vnd.powerbuilder6
+application/vnd.powerbuilder6-s
+application/vnd.powerbuilder7
+application/vnd.powerbuilder7-s
+application/vnd.powerbuilder75
+application/vnd.powerbuilder75-s
+application/vnd.previewsystems.box
+application/vnd.publishare-delta-tree
+application/vnd.pvi.ptid1
+application/vnd.pwg-multiplexed
+application/vnd.pwg-xhtml-print+xml
+application/vnd.quark.quarkxpress
+application/vnd.rapid
+application/vnd.rn-realmedia rm
+application/vnd.s3sms
+application/vnd.sealed.net
+application/vnd.seemail
+application/vnd.shana.informed.formdata
+application/vnd.shana.informed.formtemplate
+application/vnd.shana.informed.interchange
+application/vnd.shana.informed.package
+application/vnd.smaf
+application/vnd.sss-cod
+application/vnd.sss-dtf
+application/vnd.sss-ntf
+application/vnd.street-stream
+application/vnd.svd
+application/vnd.swiftview-ics
+application/vnd.triscape.mxs
+application/vnd.trueapp
+application/vnd.truedoc
+application/vnd.ufdl
+application/vnd.uplanet.alert
+application/vnd.uplanet.alert-wbxml
+application/vnd.uplanet.bearer-choice
+application/vnd.uplanet.bearer-choice-wbxml
+application/vnd.uplanet.cacheop
+application/vnd.uplanet.cacheop-wbxml
+application/vnd.uplanet.channel
+application/vnd.uplanet.channel-wbxml
+application/vnd.uplanet.list
+application/vnd.uplanet.list-wbxml
+application/vnd.uplanet.listcmd
+application/vnd.uplanet.listcmd-wbxml
+application/vnd.uplanet.signal
+application/vnd.vcx
+application/vnd.vectorworks
+application/vnd.vidsoft.vidconference
+application/vnd.visio
+application/vnd.visionary
+application/vnd.vividence.scriptfile
+application/vnd.vsf
+application/vnd.wap.sic
+application/vnd.wap.slc
+application/vnd.wap.wbxml wbxml
+application/vnd.wap.wmlc wmlc
+application/vnd.wap.wmlscriptc wmlsc
+application/vnd.webturbo
+application/vnd.wrq-hp3000-labelled
+application/vnd.wt.stf
+application/vnd.wv.csp+wbxml
+application/vnd.xara
+application/vnd.xfdl
+application/vnd.yamaha.hv-dic
+application/vnd.yamaha.hv-script
+application/vnd.yamaha.hv-voice
+application/vnd.yellowriver-custom-menu
+application/voicexml+xml vxml
+application/watcherinfo+xml
+application/whoispp-query
+application/whoispp-response
+application/wita
+application/wordperfect5.1
+application/x-bcpio bcpio
+application/x-cdlink vcd
+application/x-chess-pgn pgn
+application/x-compress
+application/x-cpio cpio
+application/x-csh csh
+application/x-director dcr dir dxr
+application/x-dvi dvi
+application/x-futuresplash spl
+application/x-gtar gtar
+application/x-gzip
+application/x-hdf hdf
+application/x-javascript js
+application/x-java-jnlp-file jnlp
+application/x-koan skp skd skt skm
+application/x-latex latex
+application/x-netcdf nc cdf
+application/x-sh sh
+application/x-shar shar
+application/x-shockwave-flash swf
+application/x-stuffit sit
+application/x-sv4cpio sv4cpio
+application/x-sv4crc sv4crc
+application/x-tar tar
+application/x-tcl tcl
+application/x-tex tex
+application/x-texinfo texinfo texi
+application/x-troff t tr roff
+application/x-troff-man man
+application/x-troff-me me
+application/x-troff-ms ms
+application/x-ustar ustar
+application/x-wais-source src
+application/x400-bp
+application/xhtml+xml xhtml xht
+application/xslt+xml xslt
+application/xml xml xsl
+application/xml-dtd dtd
+application/xml-external-parsed-entity
+application/zip zip
+audio/32kadpcm
+audio/amr
+audio/amr-wb
+audio/basic au snd
+audio/cn
+audio/dat12
+audio/dsr-es201108
+audio/dvi4
+audio/evrc
+audio/evrc0
+audio/g722
+audio/g.722.1
+audio/g723
+audio/g726-16
+audio/g726-24
+audio/g726-32
+audio/g726-40
+audio/g728
+audio/g729
+audio/g729D
+audio/g729E
+audio/gsm
+audio/gsm-efr
+audio/l8
+audio/l16
+audio/l20
+audio/l24
+audio/lpc
+audio/midi mid midi kar
+audio/mpa
+audio/mpa-robust
+audio/mp4a-latm m4a m4p
+audio/mpeg mpga mp2 mp3
+audio/parityfec
+audio/pcma
+audio/pcmu
+audio/prs.sid
+audio/qcelp
+audio/red
+audio/smv
+audio/smv0
+audio/telephone-event
+audio/tone
+audio/vdvi
+audio/vnd.3gpp.iufp
+audio/vnd.cisco.nse
+audio/vnd.cns.anp1
+audio/vnd.cns.inf1
+audio/vnd.digital-winds
+audio/vnd.everad.plj
+audio/vnd.lucent.voice
+audio/vnd.nortel.vbk
+audio/vnd.nuera.ecelp4800
+audio/vnd.nuera.ecelp7470
+audio/vnd.nuera.ecelp9600
+audio/vnd.octel.sbc
+audio/vnd.qcelp
+audio/vnd.rhetorex.32kadpcm
+audio/vnd.vmx.cvsd
+audio/x-aiff aif aiff aifc
+audio/x-alaw-basic
+audio/x-mpegurl m3u
+audio/x-pn-realaudio ram ra
+audio/x-pn-realaudio-plugin
+audio/x-wav wav
+chemical/x-pdb pdb
+chemical/x-xyz xyz
+image/bmp bmp
+image/cgm cgm
+image/g3fax
+image/gif gif
+image/ief ief
+image/jpeg jpeg jpg jpe
+image/jp2 jp2
+image/naplps
+image/pict pict pic pct
+image/png png
+image/prs.btif
+image/prs.pti
+image/svg+xml svg
+image/t38
+image/tiff tiff tif
+image/tiff-fx
+image/vnd.cns.inf2
+image/vnd.djvu djvu djv
+image/vnd.dwg
+image/vnd.dxf
+image/vnd.fastbidsheet
+image/vnd.fpx
+image/vnd.fst
+image/vnd.fujixerox.edmics-mmr
+image/vnd.fujixerox.edmics-rlc
+image/vnd.globalgraphics.pgb
+image/vnd.mix
+image/vnd.ms-modi
+image/vnd.net-fpx
+image/vnd.svf
+image/vnd.wap.wbmp wbmp
+image/vnd.xiff
+image/x-cmu-raster ras
+image/x-macpaint pntg pnt mac
+image/x-icon ico
+image/x-portable-anymap pnm
+image/x-portable-bitmap pbm
+image/x-portable-graymap pgm
+image/x-portable-pixmap ppm
+image/x-quicktime qtif qti
+image/x-rgb rgb
+image/x-xbitmap xbm
+image/x-xpixmap xpm
+image/x-xwindowdump xwd
+message/delivery-status
+message/disposition-notification
+message/external-body
+message/http
+message/news
+message/partial
+message/rfc822
+message/s-http
+message/sip
+message/sipfrag
+model/iges igs iges
+model/mesh msh mesh silo
+model/vnd.dwf
+model/vnd.flatland.3dml
+model/vnd.gdl
+model/vnd.gs-gdl
+model/vnd.gtw
+model/vnd.mts
+model/vnd.parasolid.transmit.binary
+model/vnd.parasolid.transmit.text
+model/vnd.vtu
+model/vrml wrl vrml
+multipart/alternative
+multipart/appledouble
+multipart/byteranges
+multipart/digest
+multipart/encrypted
+multipart/form-data
+multipart/header-set
+multipart/mixed
+multipart/parallel
+multipart/related
+multipart/report
+multipart/signed
+multipart/voice-message
+text/calendar ics ifb
+text/css css
+text/directory
+text/enriched
+text/html html htm
+text/parityfec
+text/plain asc txt
+text/prs.lines.tag
+text/rfc822-headers
+text/richtext rtx
+text/rtf rtf
+text/sgml sgml sgm
+text/t140
+text/tab-separated-values tsv
+text/uri-list
+text/vnd.abc
+text/vnd.curl
+text/vnd.dmclientscript
+text/vnd.fly
+text/vnd.fmi.flexstor
+text/vnd.in3d.3dml
+text/vnd.in3d.spot
+text/vnd.iptc.nitf
+text/vnd.iptc.newsml
+text/vnd.latex-z
+text/vnd.motorola.reflex
+text/vnd.ms-mediapackage
+text/vnd.net2phone.commcenter.command
+text/vnd.sun.j2me.app-descriptor
+text/vnd.wap.si
+text/vnd.wap.sl
+text/vnd.wap.wml wml
+text/vnd.wap.wmlscript wmls
+text/x-setext etx
+text/xml
+text/xml-external-parsed-entity
+video/bmpeg
+video/bt656
+video/celb
+video/dv
+video/h261
+video/h263
+video/h263-1998
+video/h263-2000
+video/jpeg
+video/mp1s
+video/mp2p
+video/mp2t
+video/mp4 mp4
+video/mp4v-es
+video/mpv
+video/mpeg mpeg mpg mpe
+video/nv
+video/parityfec
+video/pointer
+video/quicktime qt mov
+video/smpte292m
+video/vnd.fvt
+video/vnd.motorola.video
+video/vnd.motorola.videop
+video/vnd.mpegurl mxu m4u
+video/vnd.nokia.interleaved-multimedia
+video/vnd.objectvideo
+video/vnd.vivo
+video/x-dv dv dif
+video/x-msvideo avi
+video/x-sgi-movie movie
+x-conference/x-cooltalk ice
1  README
@@ -0,0 +1 @@
+Turbinado is a stab at producing a Rails-ish MVC web framework for Haskell. A very early stab...
4 Setup.lhs
@@ -0,0 +1,4 @@
+#! /usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
40 Turbinado/Controller.hs
@@ -0,0 +1,40 @@
+module Turbinado.Controller (
+ getEnvironment,
+ evalController,
+ -- limited export from Turbinado.Controller.Monad
+ Controller,
+ runController,
+ -- * Functions
+ doIO, catch,
+
+ module Turbinado.Environment,
+ module Turbinado.Environment.CodeStore,
+ module Turbinado.Environment.Request,
+ module Turbinado.Environment.Response,
+ ) where
+
+import Control.Exception (catchDyn)
+import Control.Monad
+import Control.Monad.State
+import Control.Monad.Trans (MonadIO(..))
+import qualified Network.HTTP as HTTP
+import Prelude hiding (catch)
+
+import Turbinado.Environment
+import Turbinado.Environment.Request
+import Turbinado.Environment.Response
+import Turbinado.Controller.Monad
+import Turbinado.Environment.CodeStore
+import Turbinado.Utility.General
+
+
+evalController :: Controller () -> EnvironmentFilter
+evalController p e = runController p e
+
+
+--
+-- * Environment functions
+--
+
+getEnvironment :: Controller Environment
+getEnvironment = get
32 Turbinado/Controller/Exception.hs
@@ -0,0 +1,32 @@
+{-# OPTIONS -fglasgow-exts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Turbinado.Exception
+-- Copyright : (c) Niklas Broberg 2008
+-- License : BSD-style (see the file LICENSE.txt)
+--
+-- Maintainer : Niklas Broberg, nibro@cs.chalmers.se
+-- Stability : experimental
+-- Portability : needs dynamic exceptions and deriving Typeable
+--
+-- Defines a datatype for runtime exceptions that may arise during
+-- the evaluation of a Turbinado page.
+-----------------------------------------------------------------------------
+module Turbinado.Controller.Exception (
+ Exception(..),
+ throwController
+ ) where
+
+import Data.Typeable
+import Control.Exception (throwDyn)
+
+data Exception
+ = ParameterLookupFailed String -- ^ User tried to do an irrefutable parameter lookup
+ -- that failed.
+ -- | ... I'm sure there should be more exceptions, we'll add them when we get to them.
+ deriving (Eq, Show, Typeable)
+
+-- Internal funcion that throws a dynamic exception particular to Turbinado.
+throwController :: Exception -> a
+throwController = throwDyn
+
47 Turbinado/Controller/Monad.hs
@@ -0,0 +1,47 @@
+module Turbinado.Controller.Monad (
+ -- * The 'Controller' Monad
+ Controller,
+ runController,
+ -- * Functions
+ doIO, catch
+ ) where
+
+import Control.Exception (catchDyn)
+
+import Control.Monad.State
+import Control.Monad.Trans (MonadIO(..))
+import Data.Maybe
+import Prelude hiding (catch)
+
+import Turbinado.Environment
+import Turbinado.Controller.Exception
+import Turbinado.Utility.General
+
+
+--------------------------------------------------------------
+-- The Controller Monad
+
+-- | The Controller monad is a state wrapper around
+-- the IO monad.
+
+type Controller = StateT Environment IO
+
+
+-- | Runs a Controller computation in a particular environment. Since Controller wraps the IO monad,
+-- the result of running it will be an IO computation.
+runController :: Controller () -> Environment -> IO Environment
+runController c e = (execStateT c) e
+
+-- | Execute an IO computation within the Controller monad.
+doIO :: IO a -> Controller a
+doIO = liftIO
+
+-----------------------------------------------------------------------
+-- Exception handling
+
+-- | Catch a user-caused exception.
+catch :: Controller a -> (Exception -> Controller a) -> Controller a
+catch (StateT f) handler = StateT $ \e ->
+ f e `catchDyn` (\ex -> (let (StateT g) = handler ex
+ in g e))
+
38 Turbinado/Database/ORM/Generator.hs
@@ -0,0 +1,38 @@
+module Turbinado.Database.ORM.Generator where
+
+
+import qualified Data.Map as M
+
+
+type ConnectionString = String
+type TableName = String
+type ColumnName = String
+type Column = (SqlColDesc, DependentKeys, Boolean) -- Boolean == isPrimaryKey
+type DependentKeys = [(TableName, ColumnName)] -- all columns which are targets of foreign keys
+
+type TableColumn = (TableName, ColumnName)
+type TableColumns = M.Map TableColumn Column
+
+generateModels :: FilePath -> IO ()
+generateModels cs fp = do conn <- openDBConnection
+ ts <- Database.HDBC.getTables conn
+ ds <- zip ts $ mapM (describeTable conn) ts
+ let tcs = combineTablesColumns ts ds
+ pks <- getPrimaryKeys conn t
+ let tcs' = combinePrimaryKeys tcs pks
+ fks <- getForeignKeys t
+ let tcs'' = foldl
+
+
+combineTablesColumns :: [TableName] -> [(ColumnName, SqlColDesc)] -> TableColumn
+combineTablesColumsn ts cs =
+ M.fromList $ zipWith (\t (c, d) -> ((t,c), (d, [], False)) ) ts cs
+
+combinePrimaryKeys :: [(TableName, [ColumnName])] -> TableColumns -> TableColumns
+combinePrimaryKeys pks tcs =
+ foldl (\tcs (t, cs) -> foldl (\c -> M.adjust (\(d,k,_) -> (d, k, True)) (t, c) ) tcs cs) tcs pks
+
+addDependentKey :: (TableColumn, TableColumn) -> TableColumns -> TableColumns
+addDependentKey (parTable, parColumn), ((depTable, depColumn)) t =
+ let c@(d, k, i) = M.lookup (parTable, parColumn) t in
+ M.insert (parTable, parColumn) (d, k `union` (depTable, depColumn), i)
230 Turbinado/Database/ORM/Output.hs
@@ -0,0 +1,230 @@
+module Database.HDBC.Generator where
+import qualified Data.Char
+import Control.Monad
+import Data.Dynamic
+import Data.List
+import Database.HDBC
+import System.Directory
+
+type TableName = String
+type ParentName = String
+type TypeName = String
+type PrimaryKeyColumnNames = [String]
+type PrimaryKeyTypeNames = [String]
+
+data TableSpec = TableSpec {
+ tableName :: String,
+ primaryKey :: (PrimaryKeyColumnNames, PrimaryKeyTypeNames),
+ columnDescriptions :: [(String, SqlColDesc)]
+ }
+
+generateModels conn parentName =
+ do writeFile "Bases/ModelBase.hs" generateModelBase
+ mapM (\t -> let typeName = (capitalizeName t)
+ fullName = typeName ++ "Model" in
+ do desc <- describeTable conn t
+ writeFile ("Bases/" ++ fullName ++ "Base.hs") (generateModel parentName typeName (TableSpec t (getPrimaryKeysFromDesc desc) desc))
+ doesFileExist (fullName ++ ".hs") >>= (\e -> when (not e) (writeFile (fullName++".hs") (generateModelFile parentName typeName) ) ) )
+ =<< (getTables conn)
+
+getPrimaryKeysFromDesc:: [(String, SqlColDesc)] -> (PrimaryKeyColumnNames, PrimaryKeyTypeNames)
+getPrimaryKeysFromDesc desc =
+ worker ([],[]) desc
+ where worker (c,t) [] = (c,t)
+ worker (c,t) (d:ds) = worker (if ((colIsPrimaryKey $ snd d) == True) then (c++[fst d], t++[getHaskellTypeString $ colType $ snd d]) else (c,t)) ds
+
+generateModelFile parentName modelName =
+ let fullName = (if (length parentName > 0) then parentName ++ "." else "") ++ modelName ++ "Model"
+ in unlines $
+ ["module " ++ fullName
+ ," ( module " ++ fullName
+ ," , module Bases." ++ fullName ++ "Base "
+ ," ) where"
+ ,"import Bases." ++ fullName ++ "Base"
+ ]
+
+generateModelBase :: String
+generateModelBase = unlines $
+ ["{- DO NOT EDIT THIS FILE"
+ ," THIS FILE IS AUTOMAGICALLY GENERATED AND YOUR CHANGES WILL BE EATEN BY THE GENERATOR OVERLORD -}"
+ ,""
+ ,"module ModelBase ("
+ ," module ModelBase,"
+ ," module Control.Exception,"
+ ," module Database.HDBC,"
+ ," module Data.Int"
+ ,") where"
+ ,""
+ ,"import Control.Exception"
+ ,"import Database.HDBC"
+ ,"import Data.Int"
+ ,""
+ ,"{- Using phantom types here -}"
+ ,"class DatabaseModel m where"
+ ," tableName :: m -> String"
+ ,""
+ ,"type SelectString = String"
+ ,"type SelectParams = [SqlValue]"
+ ,""
+ ,"class (DatabaseModel model) =>"
+ ," HasFindByPrimaryKey model primaryKey | model -> primaryKey where"
+ ," find :: IConnection conn => conn -> primaryKey -> IO model"
+ ,""
+ ,"class (DatabaseModel model) =>"
+ ," HasFinders model where"
+ ," findAll :: IConnection conn => conn -> IO [model]"
+ ," findAllBy :: IConnection conn => conn -> SelectString -> SelectParams -> IO [model]"
+ ," findOneBy :: IConnection conn => conn -> SelectString -> SelectParams -> IO model"
+ ,""
+ ]
+{-------------------------------------------------------------------------}
+generateModel :: ParentName ->
+ TypeName ->
+ TableSpec ->
+ String
+generateModel parentName typeName tspec =
+ let cleanParentName = if (length parentName > 0) then parentName ++ "." else ""
+ in unlines $
+ ["{- DO NOT EDIT THIS FILE"
+ ," THIS FILE IS AUTOMAGICALLY GENERATED AND YOUR CHANGES WILL BE EATEN BY THE GENERATOR OVERLORD"
+ ,""
+ ," All changes should go into the Model file (e.g. ExampleModel.hs) and"
+ ," not into the base file (e.g. ExampleModelBase.hs) -}"
+ ,""
+ ,"module " ++ cleanParentName ++ typeName ++ "ModelBase ( "
+ ," module Bases." ++ cleanParentName ++ typeName ++ "ModelBase, "
+ ," module " ++ cleanParentName ++ "ModelBase) where"
+ , ""
+ , "import Bases." ++ cleanParentName ++ "ModelBase"
+ , ""
+ , "data " ++ typeName ++ " = " ++ typeName ++ " {"
+ ] ++
+ addCommas (map columnToFieldLabel (columnDescriptions tspec)) ++
+ [ " } deriving (Eq, Show)"
+ , ""
+ , "instance DatabaseModel " ++ typeName ++ " where"
+ , " tableName _ = \"" ++ tableName tspec ++ "\""
+ , ""
+ ] ++
+ generateFindByPrimaryKey typeName tspec ++
+ generateFinders typeName tspec
+
+{-------------------------------------------------------------------------}
+columnToFieldLabel :: (String, SqlColDesc) -> String
+columnToFieldLabel (name, desc) =
+ " " ++ partiallyCapitalizeName name ++ " :: " ++
+ (if ((colNullable desc) == Just True) then "Maybe " else "") ++
+ getHaskellTypeString (colType desc)
+
+{-------------------------------------------------------------------------}
+generateFindByPrimaryKey :: TypeName -> TableSpec -> [String]
+generateFindByPrimaryKey typeName tspec =
+ case (length $ fst $ primaryKey tspec) of
+ 0 -> [""]
+ _ -> ["instance HasFindByPrimaryKey " ++ typeName ++ " " ++ " (" ++ unwords (intersperse "," (snd $ primaryKey tspec)) ++ ") " ++ " where"
+ ," find conn pk@(" ++ (concat $ intersperse ", " $ map (\i -> "pk"++(show i)) [1..(length $ fst $ primaryKey tspec)]) ++ ") = do"
+ ," res <- quickQuery' conn (\"SELECT * FROM " ++ tableName tspec ++ " WHERE (" ++ generatePrimaryKeyWhere (fst $ primaryKey tspec) ++ "++ \")\") []"
+ ," case res of"
+ ," [] -> throwDyn $ SqlError"
+ ," {seState = \"\","
+ ," seNativeError = (-1),"
+ ," seErrorMsg = \"No record found when finding by Primary Key:" ++ (tableName tspec) ++ " : \" ++ (show pk)"
+ ," }"
+ ," r:[] -> return $ " ++ (generateConstructor typeName tspec)
+ ," _ -> throwDyn $ SqlError"
+ ," {seState = \"\","
+ ," seNativeError = (-1),"
+ ," seErrorMsg = \"Too many records found when finding by Primary Key:" ++ (tableName tspec) ++ " : \" ++ (show pk)"
+ ," }"
+ ]
+
+generateFinders :: TypeName -> TableSpec -> [String]
+generateFinders typeName tspec =
+ ["instance HasFinders " ++ typeName ++ " where"
+ ," findAll conn = do"
+ ," res <- quickQuery' conn \"SELECT * FROM " ++ tableName tspec ++ "\" []"
+ ," return $ map (\\r -> " ++ generateConstructor typeName tspec ++ ") res"
+ ," findAllBy conn ss sp = do"
+ ," res <- quickQuery' conn (\"SELECT * FROM " ++ tableName tspec ++ " WHERE (\" ++ ss ++ \") \") sp"
+ ," return $ map (\\r -> " ++ generateConstructor typeName tspec ++ ") res"
+ ," findOneBy conn ss sp = do"
+ ," res <- quickQuery' conn (\"SELECT * FROM " ++ tableName tspec ++ " WHERE (\" ++ ss ++ \") LIMIT 1\") sp"
+ ," return $ (\\r -> " ++ generateConstructor typeName tspec ++ ") (head res)"
+ ]
+
+{-----------------------------------------------------------------------}
+generatePrimaryKeyWhere cnames =
+ unwords $
+ intersperse "++ \" AND \" ++ \"" $
+ map (\(c,i) -> c ++ " = \" ++ (show pk" ++ (show i) ++ ")") (zip cnames [1..])
+
+generateConstructor typeName tspec =
+ typeName ++ " " ++ (unwords $
+ map (\i -> "(fromSql (r !! " ++ (show i) ++ "))") [0..((length $ columnDescriptions tspec)-1)])
+
+
+{-------------------------------------------------------------------------
+ - Utility functions -
+ -------------------------------------------------------------------------}
+addCommas (s:[]) = [s]
+addCommas (s:ss) = (s ++ ",") : (addCommas ss)
+
+getHaskellTypeString :: SqlTypeId -> String
+getHaskellTypeString SqlCharT = "String"
+getHaskellTypeString SqlVarCharT = "String"
+getHaskellTypeString SqlLongVarCharT = "String"
+getHaskellTypeString SqlWCharT = "String"
+getHaskellTypeString SqlWVarCharT = "String"
+getHaskellTypeString SqlWLongVarCharT = "String"
+getHaskellTypeString SqlDecimalT = "Rational"
+getHaskellTypeString SqlNumericT = "Rational"
+getHaskellTypeString SqlSmallIntT ="Int32"
+getHaskellTypeString SqlIntegerT = "Int32"
+getHaskellTypeString SqlRealT = "Rational"
+getHaskellTypeString SqlFloatT = "Float"
+getHaskellTypeString SqlDoubleT = "Double"
+getHaskellTypeString SqlTinyIntT = "Int32"
+getHaskellTypeString SqlBigIntT = "Int64"
+getHaskellTypeString SqlDateT = "UTCTime"
+getHaskellTypeString SqlTimeT = "UTCTime"
+getHaskellTypeString SqlTimestampT = "UTCTime"
+getHaskellTypeString SqlUTCDateTimeT = "UTCTime"
+getHaskellTypeString SqlUTCTimeT = "UTCTime"
+getHaskellTypeString _ = error "Don't know how to translate this SqlTypeId to a SqlValue"
+
+
+type SelectParameters = String
+
+class TableType a where
+ find :: (IConnection conn) => conn -> Int -> a
+ findBy :: (IConnection conn) => conn -> SelectParameters -> [a]
+
+{- Converts "column_name" to "ColumnName"
+ -}
+capitalizeName colname =
+ concat $
+ map (\(s:ss) -> (Data.Char.toUpper s) : ss) $
+ words $
+ map (\c -> if (c=='_') then ' ' else c) colname
+
+
+partiallyCapitalizeName colname =
+ (\(s:ss) -> (Data.Char.toLower s) : ss) $
+ capitalizeName colname
+
+{- If a column ends with "_id" then it's a foreign key
+ -}
+isForeignKey colname =
+ drop (length colname - 3) colname == "_id"
+
+
+{-
+PostgreSQL query to get Primary Keys:
+SELECT pg_attribute.attname
+ FROM pg_class
+ JOIN pg_namespace ON pg_namespace.oid=pg_class.relnamespace AND pg_namespace.nspname NOT LIKE 'pg_%' AND pg_class.relname like 'abba%'
+ JOIN pg_attribute ON pg_attribute.attrelid=pg_class.oid AND pg_attribute.attisdropped='f'
+ JOIN pg_index ON pg_index.indrelid=pg_class.oid AND pg_index.indisprimary='t' AND ( pg_index.indkey[0]=pg_attribute.attnum OR pg_inde
+x.indkey[1]=pg_attribute.attnum OR pg_index.indkey[2]=pg_attribute.attnum OR pg_index.indkey[3]=pg_attribute.attnum OR pg_index.indkey[4]=pg_attribute.attnum OR pg_index.indkey[5]=pg_attribute.attnum OR pg_index.indkey[6]=pg_attribute.attnum OR pg_index.indkey[7]=pg_attribute.attnum OR pg_index.indkey[8]=pg_attribute.attnum OR pg_index.indkey[9]=pg_attribute.attnum )
+ ORDER BY pg_namespace.nspname, pg_class.relname,pg_attribute.attname;
+-}
21 Turbinado/Database/ORM/PostgreSQL.hs
@@ -0,0 +1,21 @@
+module Turbinado.Database.ORM.PostgreSQL where
+
+import Database.HDBC
+
+getPrimaryKeys :: IConnection conn => conn -> String -> [String]
+getPrimaryKeys conn t = quickQuery conn (concatenate [
+ " SELECT ins.tablename, ins.indexname, i.indkey, a.*"
+ ," FROM pg_indexes ins "
+ ," INNER JOIN pg_class c ON ins.indexname = c.relname "
+ ," INNER JOIN pg_index i ON c.oid = i.indexrelid "
+ ," INNER JOIN pg_attribute a ON c.oid = a.attrelid "
+ ," WHERE ins.tablename = '" ++ t ++ "' AND contype = 'f';"]) []
+
+getForeignKeys :: IConnection conn => conn -> String -> [String]
+getForeignKeys conn t = quickQuery conn (concatenate [
+ " SELECT ins.tablename, ins.indexname, i.indkey, a.*"
+ ," FROM pg_indexes ins "
+ ," INNER JOIN pg_class c ON ins.indexname = c.relname "
+ ," INNER JOIN pg_index i ON c.oid = i.indexrelid "
+ ," INNER JOIN pg_attribute a ON c.oid = a.attrelid "
+ ," WHERE ins.tablename = '" ++ t ++ "';"]) []
30 Turbinado/Environment.hs
@@ -0,0 +1,30 @@
+module Turbinado.Environment (
+ Environment,
+ EnvironmentFilter,
+ newEnvironment,
+ getKey,
+ setKey
+ ) where
+
+import Data.Dynamic
+import Data.Map
+import Data.Maybe
+import System.IO
+import System.IO.Unsafe
+import System.Log.Logger
+
+-- Using Dynamic for two reasons:
+-- 1) Break module cycles (Environment doesn't import the various Request, Response, etc bits
+-- 2) Extensibility - easy for plugins to add data to the Environment
+type Environment = Map String Dynamic
+
+type EnvironmentFilter = Environment -> IO Environment
+
+newEnvironment :: IO Environment
+newEnvironment = return (empty :: Environment)
+
+getKey :: (Typeable a) => String -> Environment -> a
+getKey k e = fromJust $ fromDynamic $ e ! k
+
+setKey :: (Typeable a) => String -> a -> EnvironmentFilter
+setKey k v = \e -> return $ insert k (toDyn v) e
BIN  Turbinado/Environment/.ViewData.hs.swp
Binary file not shown
195 Turbinado/Environment/CodeStore.hs
@@ -0,0 +1,195 @@
+module Turbinado.Environment.CodeStore (
+ addCodeStoreToEnvironment,
+ getCodeStore,
+ setCodeStore,
+ CodeType (..),
+ retrieveCode,
+ CodeStore (..),
+ CodeMap,
+ CodeStatus (..)
+ ) where
+
+import Control.Concurrent.MVar
+import Control.Exception ( catch, throwIO )
+import Control.Monad ( when, foldM)
+import Data.Map hiding (map)
+import Data.Maybe
+import Data.Typeable
+import qualified Network.HTTP as HTTP
+import Prelude hiding (lookup,catch)
+import System.Directory
+import System.FilePath
+import System.IO ( openFile, IOMode(..), hGetLine, hIsEOF )
+import System.Plugins
+import System.Plugins.Utils
+import System.Time
+
+import Config.Master
+
+import qualified Turbinado.Server.Exception as Ex
+import Turbinado.Environment.Logger
+import Turbinado.Environment
+import Turbinado.Environment.Request
+import Turbinado.Environment.Response
+import Turbinado.View.Monad
+import Turbinado.View.XML
+import Turbinado.Controller.Monad
+
+type CodeDate = ClockTime
+type Function = String
+type CodeLocation = (FilePath, Function)
+
+data CodeStore = CodeStore (MVar CodeMap)
+ deriving Typeable
+type CodeMap = Map CodeLocation CodeStatus
+data CodeStatus = CodeLoadFailure |
+ CodeLoadController (Controller ()) CodeDate |
+ CodeLoadView (View XML ) CodeDate
+
+-- | Create a new store for Code data
+addCodeStoreToEnvironment :: EnvironmentFilter
+addCodeStoreToEnvironment e = do mv <- newMVar $ empty
+ setCodeStore (CodeStore mv) e
+
+codeStoreKey = "codestore"
+
+getCodeStore :: Environment -> CodeStore
+getCodeStore = getKey codeStoreKey
+
+setCodeStore :: CodeStore -> EnvironmentFilter
+setCodeStore req = setKey codeStoreKey req
+
+
+data CodeType = CTView | CTController | CTLayout
+
+retrieveCode :: Environment -> CodeType -> CodeLocation -> IO CodeStatus
+retrieveCode e ct cl' = do
+ let (CodeStore mv) = getCodeStore e
+ path = getDir ct
+ cl <- do d <- getCurrentDirectory
+ return (addExtension (joinPath $ map normalise [d, path, dropExtension $ fst cl']) "hs", snd cl')
+ debugM e $ " CodeStore : retrieveCode : loading " ++ (fst cl) ++ " - " ++ (snd cl)
+ cmap <- takeMVar mv
+ let c= lookup cl cmap
+ cmap' <- case c of
+ Nothing -> do debugM e ((fst cl) ++ " : " ++ (snd cl) ++ " : fresh load")
+ loadCode e ct cmap cl
+ Just CodeLoadFailure -> do debugM e ((fst cl) ++ " : " ++ (snd cl) ++ " : previous failure; try load")
+ loadCode e ct cmap cl
+ _ -> do debugM e ((fst cl) ++ " : " ++ (snd cl) ++ " : checking reload")
+ checkReloadCode e ct cmap (fromJust c) cl
+ putMVar mv cmap'
+ -- We _definitely_ have a code entry now, though it may have a MakeFailure
+ let c' = lookup cl cmap'
+ case c' of
+ Nothing -> do debugM e (fst cl ++ " : Not found in CodeStore")
+ return CodeLoadFailure
+ Just CodeLoadFailure -> do debugM e (fst cl ++ " : CodeLoadFailure " )
+ return CodeLoadFailure
+ Just clc@(CodeLoadController _ _) -> do debugM e (fst cl ++ " : CodeLoadController " )
+ return clc
+ Just clv@(CodeLoadView _ _) -> do debugM e (fst cl ++ " : CodeLoadView" )
+ return clv
+
+checkReloadCode :: Environment -> CodeType -> CodeMap -> CodeStatus -> CodeLocation -> IO CodeMap
+checkReloadCode e ct cmap CodeLoadFailure cl = error "ERROR: checkReloadCode was called with a CodeLoadFailure"
+checkReloadCode e ct cmap cstat cl = do
+ debugM e $ " CodeStore : checkReloadCode : loading " ++ (fst cl) ++ " - " ++ (snd cl)
+ r <- needReloadCode e (fst cl) (getDate cstat)
+ case r of
+ False -> return cmap
+ True -> loadCode e ct cmap cl
+
+
+-- The beast
+-- In cases of Merge, Make or Load failures leave the original files in place and log the error
+loadCode :: Environment -> CodeType -> CodeMap -> CodeLocation -> IO CodeMap
+loadCode e ct cmap cl = do
+ debugM e $ " CodeStore : loadCode : loading " ++ (fst cl) ++ " - " ++ (snd cl)
+ fe <- doesFileExist $ fst cl
+ case fe of
+ False -> debugM e ("File not found: " ++ fst cl) >> return cmap
+ True -> mergeCode e ct cmap cl
+
+mergeCode :: Environment -> CodeType -> CodeMap -> CodeLocation -> IO CodeMap
+mergeCode e ct cmap cl = do
+ debugM e $ " Merging " ++ (fst cl)
+ d <- getCurrentDirectory
+ debugM e $ " stub " ++ joinPath [normalise d, normalise $ getStub ct]
+ ms <- mergeToDir (joinPath [normalise d, normalise $ getStub ct]) (fst cl) compiledDir
+ case ms of
+ MergeFailure err -> do debugM e ("Merge error : " ++ (show err))
+ return $ insert cl CodeLoadFailure cmap
+ MergeSuccess NotReq _ _ -> do debugM e ("Merge success (No recompilation required) : " ++ (fst cl))
+ return cmap
+ MergeSuccess _ args fp -> do debugM e ("Merge success : " ++ (fst cl))
+ makeCode e ct cmap cl args fp
+
+makeCode :: Environment -> CodeType -> CodeMap -> CodeLocation -> [Arg] -> FilePath -> IO CodeMap
+makeCode e ct cmap cl args fp = do
+ ms <- makeAll fp (compileArgs++args)
+ case ms of
+ MakeFailure err -> do debugM e ("Make error : " ++ (show err))
+ return (insert cl CodeLoadFailure cmap)
+ MakeSuccess NotReq _ -> do debugM e ("Make success : No recomp required")
+ return (insert cl CodeLoadFailure cmap)
+ MakeSuccess _ fp -> do debugM e ("Make success : " ++ fp)
+ case ct of
+ CTController -> _loadController e ct cmap cl fp
+ _ -> _loadView e ct cmap cl fp
+
+_loadController :: Environment -> CodeType -> CodeMap -> CodeLocation -> FilePath -> IO CodeMap
+_loadController e ct cmap cl fp = do
+ debugM e ("loadController : " ++ (fst cl) ++ " : " ++ (snd cl))
+ ls <- load fp [compiledDir] [] (snd cl)
+ case ls of
+ LoadFailure err -> do debugM e ("LoadFailure : " ++ (show err))
+ return (insert cl CodeLoadFailure cmap)
+ LoadSuccess m f -> do debugM e ("LoadSuccess : " ++ fst cl )
+ t <- getClockTime
+ return (insert cl (CodeLoadController f t) cmap)
+
+_loadView :: Environment -> CodeType -> CodeMap -> CodeLocation -> FilePath -> IO CodeMap
+_loadView e ct cmap cl fp = do
+ debugM e ("loadView : " ++ (fst cl) ++ " : " ++ (snd cl))
+ ls <- load fp [compiledDir] [] (snd cl)
+ case ls of
+ LoadFailure err -> do debugM e ("LoadFailure : " ++ (show err))
+ return (insert cl CodeLoadFailure cmap)
+ LoadSuccess m f -> do debugM e ("LoadSuccess : " ++ fst cl )
+ t <- getClockTime
+ return (insert cl (CodeLoadView f t) cmap)
+
+
+-------------------------------------------------------------------------------------------------
+-- Utility functions
+-------------------------------------------------------------------------------------------------
+
+needReloadCode :: Environment -> FilePath -> CodeDate -> IO Bool
+needReloadCode e fp fd = do
+ fe <- doesFileExist fp
+ case fe of
+ True -> do mt <- getModificationTime fp
+ return $ mt > fd
+ False-> return True
+
+
+
+snd' :: (a, b, c) -> b
+snd' (a,b,c) = b
+
+getDir :: CodeType -> FilePath
+getDir ct = case ct of
+ CTLayout -> layoutDir
+ CTController -> controllerDir
+ CTView -> viewDir
+
+getStub :: CodeType -> FilePath
+getStub ct = case ct of
+ CTLayout -> layoutStub
+ CTController -> controllerStub
+ CTView -> viewStub
+
+getDate CodeLoadFailure = error "getDate called with CodeLoadFailure"
+getDate (CodeLoadView _ d) = d
+getDate (CodeLoadController _ d) = d
133 Turbinado/Environment/Cookie.hs
@@ -0,0 +1,133 @@
+module Turbinado.Data.Cookie where
+
+import Data.Char (isSpace)
+import Data.List (intersperse)
+import Data.Maybe (catMaybes)
+import System.Locale (defaultTimeLocale, rfc822DateFormat)
+import System.Time (CalendarTime(..), Month(..), Day(..),
+ formatCalendarTime)
+
+--
+-- * Types
+--
+
+-- | Contains all information about a cookie set by the server.
+data Cookie = Cookie {
+ -- | Name of the cookie.
+ cookieName :: String,
+ -- | Value of the cookie.
+ cookieValue :: String,
+ -- | Expiry date of the cookie. If 'Nothing', the
+ -- cookie expires when the browser sessions ends.
+ -- If the date is in the past, the client should
+ -- delete the cookie immediately.
+ cookieExpires :: Maybe CalendarTime,
+ -- | The domain suffix to which this cookie will be sent.
+ cookieDomain :: Maybe String,
+ -- | The path to which this cookie will be sent.
+ cookiePath :: Maybe String,
+ -- | 'True' if this cookie should only be sent using
+ -- secure means.
+ cookieSecure :: Bool
+ }
+ deriving (Show, Read, Eq, Ord)
+
+
+
+--
+-- * Constructing cookies
+--
+
+-- | Construct a cookie with only name and value set.
+-- This client will expire when the browser sessions ends,
+-- will only be sent to the server and path which set it
+-- and may be sent using any means.
+newCookie :: String -- ^ Name
+ -> String -- ^ Value
+ -> Cookie -- ^ Cookie
+newCookie name value = Cookie { cookieName = name,
+ cookieValue = value,
+ cookieExpires = Nothing,
+ cookieDomain = Nothing,
+ cookiePath = Nothing,
+ cookieSecure = False
+ }
+
+--
+-- * Getting and setting cookies
+--
+
+-- | Get the value of a cookie from a string on the form
+-- @\"cookieName1=cookieValue1;...;cookieName2=cookieValue2\"@.
+-- This is the format of the @Cookie@ HTTP header.
+findCookie :: String -- ^ Cookie name
+ -> String -- ^ Semicolon separated list of name-value pairs
+ -> Maybe String -- ^ Cookie value, if found
+findCookie name s = maybeLast [ cv | (cn,cv) <- readCookies s, cn == name ]
+
+-- | Delete a cookie from the client by setting the cookie expiry date
+-- to a date in the past.
+deleteCookie :: Cookie -- ^ Cookie to delete. The only fields that matter
+ -- are 'cookieName', 'cookieDomain' and 'cookiePath'
+ -> Cookie
+deleteCookie c = c { cookieExpires = Just epoch }
+ where
+ epoch = CalendarTime {
+ ctYear = 1970,
+ ctMonth = January,
+ ctDay = 1,
+ ctHour = 0,
+ ctMin = 0,
+ ctSec = 0,
+ ctPicosec = 0,
+ ctWDay = Thursday,
+ ctYDay = 1,
+ ctTZName = "GMT",
+ ctTZ = 0,
+ ctIsDST = False
+ }
+
+--
+-- * Reading and showing cookies
+--
+
+-- | Show a cookie on the format used as the value of the Set-Cookie header.
+showCookie :: Cookie -> String
+showCookie c = concat $ intersperse "; " $
+ showPair (cookieName c) (cookieValue c)
+ : catMaybes [expires, path, domain, secure]
+ where expires = fmap (showPair "expires" . dateFmt) (cookieExpires c)
+ domain = fmap (showPair "domain") (cookieDomain c)
+ path = fmap (showPair "path") (cookiePath c)
+ secure = if cookieSecure c then Just "secure" else Nothing
+ dateFmt = formatCalendarTime defaultTimeLocale rfc822DateFormat
+
+-- | Show a name-value pair. FIXME: if the name or value
+-- contains semicolons, this breaks. The problem
+-- is that the original cookie spec does not mention
+-- how to do escaping or quoting.
+showPair :: String -- ^ name
+ -> String -- ^ value
+ -> String
+showPair name value = name ++ "=" ++ value
+
+
+-- | Gets all the cookies from a Cookie: header value
+readCookies :: String -- ^ String to parse
+ -> [(String,String)] -- ^ Cookie name - cookie value pairs
+readCookies s =
+ let (xs,ys) = break (=='=') (dropWhile isSpace s)
+ (zs,ws) = break (==';') (dropWhile isSpace (drop 1 ys))
+ in if null xs then [] else (xs,zs):readCookies (drop 1 ws)
+
+--
+-- Utilities
+--
+
+-- | Return 'Nothing' is the list is empty, otherwise return
+-- the last element of the list.
+maybeLast :: [a] -> Maybe a
+maybeLast [] = Nothing
+maybeLast xs = Just (last xs)
+
+
5 Turbinado/Environment/Header.hs
@@ -0,0 +1,5 @@
+module Turbinado.Data.Header (
+ module Network.HTTP.Headers
+ ) where
+
+import Network.HTTP.Headers
40 Turbinado/Environment/Logger.hs
@@ -0,0 +1,40 @@
+module Turbinado.Environment.Logger where
+
+import qualified System.Log.Logger as L
+import Control.Concurrent.MVar
+import Turbinado.Environment
+import Config.Master
+import Data.Dynamic
+
+addLoggerToEnvironment :: EnvironmentFilter
+addLoggerToEnvironment e = do L.updateGlobalLogger "Turbinado" (L.setLevel logLevel)
+ mv <- newMVar ()
+ setLoggerLock mv e
+
+loggerKey = "logger"
+
+getLoggerLock :: Environment -> MVar ()
+getLoggerLock = getKey loggerKey
+
+setLoggerLock :: MVar () -> EnvironmentFilter
+setLoggerLock l = setKey loggerKey l
+
+takeLoggerLock :: Environment -> IO ()
+takeLoggerLock e = takeMVar (getLoggerLock e)
+
+putLoggerLock :: Environment -> IO ()
+putLoggerLock e = putMVar (getLoggerLock e) ()
+
+wrapLoggerLock :: (String -> IO ()) -> Environment -> String -> IO ()
+wrapLoggerLock lf e s = do takeLoggerLock e
+ lf s
+ putLoggerLock e
+
+debugM = wrapLoggerLock (L.logM "Turbinado" L.DEBUG)
+infoM = wrapLoggerLock (L.logM "Turbinado" L.INFO)
+noticeM = wrapLoggerLock (L.logM "Turbinado" L.NOTICE)
+warningM = wrapLoggerLock (L.logM "Turbinado" L.WARNING)
+errorM = wrapLoggerLock (L.logM "Turbinado" L.ERROR)
+criticalM = wrapLoggerLock (L.logM "Turbinado" L.CRITICAL)
+alertM = wrapLoggerLock (L.logM "Turbinado" L.ALERT)
+emergencyM = wrapLoggerLock (L.logM "Turbinado" L.EMERGENCY)
113 Turbinado/Environment/MimeTypes.hs
@@ -0,0 +1,113 @@
+-- -----------------------------------------------------------------------------
+-- Copyright 2002, Simon Marlow.
+-- Copyright 2006, Bjorn Bringert.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+-- * Redistributions of source code must retain the above copyright notice,
+-- this list of conditions and the following disclaimer.
+--
+-- * Redistributions in binary form must reproduce the above copyright
+-- notice, this list of conditions and the following disclaimer in the
+-- documentation and/or other materials provided with the distribution.
+--
+-- * Neither the name of the copyright holder(s) nor the names of
+-- contributors may be used to endorse or promote products derived from
+-- this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+-- -----------------------------------------------------------------------------
+
+module Turbinado.Environment.MimeTypes (
+ MimeTypes (..),
+ getMimeTypes,
+ setMimeTypes,
+ mimeTypeOf,
+ addMimeTypesToEnvironment
+ ) where
+
+import Data.List
+import Data.Map (Map)
+import Data.Typeable
+import qualified Data.Map as Map hiding (Map)
+import Text.ParserCombinators.Parsec
+
+import Turbinado.Environment
+
+data MimeTypes = MimeTypes (Map String MimeType)
+ deriving (Typeable)
+data MimeType = MimeType String String
+
+instance Show MimeType where
+ showsPrec _ (MimeType part1 part2) = showString (part1 ++ '/':part2)
+
+mimeTypesKey = "mimetypes"
+
+getMimeTypes :: Environment -> MimeTypes
+getMimeTypes = getKey mimeTypesKey
+
+setMimeTypes :: MimeTypes -> EnvironmentFilter
+setMimeTypes = setKey mimeTypesKey
+
+
+mimeTypeOf :: MimeTypes -> FilePath -> Maybe MimeType
+mimeTypeOf (MimeTypes mime_types) filename =
+ do let ext = extension filename
+ if null ext
+ then Nothing
+ else Map.lookup ext mime_types
+
+extension :: String -> String
+extension fn = go (reverse fn) ""
+ where go [] _ = ""
+ go ('.':_) ext = ext
+ go (x:s) ext = go s (x:ext)
+
+addMimeTypesToEnvironment :: FilePath -> EnvironmentFilter
+addMimeTypesToEnvironment mime_types_file e =
+ do stuff <- readFile mime_types_file
+ setMimeTypes (MimeTypes $ Map.fromList (parseMimeTypes stuff)) e
+
+parseMimeTypes :: String -> [(String,MimeType)]
+parseMimeTypes file =
+ [ (ext,val)
+ | Just (val,exts) <- map (parseMimeLine . takeWhile (/= '#')) (lines file)
+ , ext <- exts
+ ]
+
+parseMimeLine :: String -> Maybe (MimeType, [String])
+parseMimeLine l = case parse pMimeLine "MIME line" l of
+ Left _ -> Nothing
+ Right m -> Just m
+
+pMimeLine :: Parser (MimeType, [String])
+pMimeLine = do t <- pMimeType
+ es <- (spaces >> sepBy pToken spaces)
+ return (t, es)
+
+pMimeType :: Parser MimeType
+pMimeType = do part1 <- pToken
+ char '/'
+ part2 <- pToken
+ return $ MimeType part1 part2
+
+especials, tokenchar :: [Char]
+especials = "()<>@,;:\\\"/[]?.="
+tokenchar = "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" \\ especials
+
+pToken :: Parser String
+pToken = many1 (oneOf tokenchar)
+
138 Turbinado/Environment/Request.hs
@@ -0,0 +1,138 @@
+module Turbinado.Environment.Request (
+ HTTP.Request(..),
+ addRequestToEnvironment,
+ getRequest,
+ setRequest,
+ modifyRequest
+ )where
+
+import qualified Network.HTTP as HTTP
+import Network.URI
+import Turbinado.Utility.General
+import qualified Data.Map as M
+import Control.Monad
+import Data.Maybe
+import Turbinado.Environment
+
+requestKey = "request"
+
+addRequestToEnvironment :: HTTP.Request -> EnvironmentFilter
+addRequestToEnvironment = setRequest
+
+getRequest :: Environment -> HTTP.Request
+getRequest = getKey requestKey
+
+setRequest :: HTTP.Request -> EnvironmentFilter
+setRequest req = setKey requestKey req
+
+modifyRequest :: (HTTP.Request -> HTTP.Request) -> EnvironmentFilter
+modifyRequest f = getRequest >>= (setRequest . f)
+
+{-
+lookupHeader :: (Monad m) => m (Maybe String)
+lookupHeader = liftM . lookupHeader
+
+lookupHeaderWithDefault :: (Monad m) => HTTP.Header -> String -> m String
+lookupHeaderWithDefault h s = do s' <- (liftM . lookupHeader) h
+ case s' of
+ Nothing -> s
+ Just s'' -> s''
+-}
+
+unEscape s = unEscapeString $ map (\ch -> if ch == '+' then ' ' else ch) s
+
+--
+-- * Environment variables
+--
+
+{-
+-- | Get the value of a Controller environment variable. Example:
+--
+-- > remoteAddr <- getVar "REMOTE_ADDR"
+getVar :: (Monad m) =>
+ String -- ^ The name of the variable.
+ -> m (Maybe String)
+getVar name = liftM (M.lookup name $ inputs)
+
+getVarWithDefault :: (Monad m) =>
+ String -- ^ The name of the variable.
+ -> String -- ^ Default value
+ -> m String
+getVarWithDefault name def = liftM (fromMaybe def) $ getVar name
+
+--
+-- * Inputs
+--
+
+-- | Get the value of an input variable, for example from a form.
+-- If the variable has multiple values, the first one is returned.
+-- Example:
+--
+-- > query <- getInput "query"
+getInput :: (Monad m) =>
+ String -- ^ The name of the variable.
+ -> m (Maybe String) -- ^ The value of the variable,
+ -- or Nothing, if it was not set.
+getInput v = lookup v `liftM` (request . getRequest)
+
+-- | Like 'getInput', but returns a 'String'.
+getInputFPS :: (Monad m) =>
+ String -- ^ The name of the variable.
+ -> m (Maybe String) -- ^ The value of the variable,
+ -- or Nothing, if it was not set.
+getInputFPS = liftM (fmap inputValue) . getInput_
+
+
+-- | Get the value of an input variable or a default value if the
+-- the input variable is not found.
+-- Example:
+--
+-- > query <- getInput "somevariable" "defaultvalue"
+getInputWithDefault :: (Monad m) =>
+ String -- ^ The name of the variable.
+ -> String -- ^ The default value.
+ -> m String -- ^ The value of the variable or default
+getInputWithDefault v s = do v' <- getInput v
+ case v'
+ of Nothing -> s
+ Just s' -> s'
+
+-- | Same as 'getInput', but tries to read the value to the desired type.
+readInput :: (Read a, Monad m) =>
+ String -- ^ The name of the variable.
+ -> m (Maybe a) -- ^ 'Nothing' if the variable does not exist
+ -- or if the value could not be interpreted
+ -- at the desired type.
+readInput = liftM (>>= maybeRead) . getInput
+
+-- | Same as 'readInput', but with a default value.
+readInputWithDefault :: (Read a, Monad m) =>
+ String -- ^ The name of the variable.
+ -> a -- ^ The default value
+ -> m (Maybe a) -- ^ 'Nothing' if the variable does not exist
+ -- or if the value could not be interpreted
+ -- at the desired type.
+readInputWithDefault v d = do v' <- liftM (>>= maybeRead) . getInput
+ case v' of Nothing -> d
+ Just v'' -> v''
+
+-}
+
+{-
+-- | Get the names and values of all inputs.
+-- Note: the same name may occur more than once in the output,
+-- if there are several values for the name.
+parseInputs :: (Monad m) => HTTP.Request -> m (M.Map String String)
+parseInputs r = do is <- r
+ return M.fromList $ [ (n, inputValue i) | (n,i) <- is ]
+
+-- Internal stuff
+
+getInput_ :: (Monad m) => String -> m (Maybe Input)
+getInput_ n = lookup n `liftM` getRequest
+
+-- | Get the uninterpreted request body as a String
+getBody :: (Monad m) => m String
+getBody = liftM (HTTP.rqBody . httpRequest) getRequest
+
+-}
150 Turbinado/Environment/Response.hs
@@ -0,0 +1,150 @@
+module Turbinado.Environment.Response (
+ HTTP.Response,
+ addResponseToEnvironment,
+ getResponse,
+ setResponse,
+ isResponseComplete
+ )where
+
+import qualified Network.HTTP as HTTP
+import Network.URI
+import Turbinado.Utility.General
+import qualified Data.Map as M
+import Control.Monad
+import Data.Maybe
+import Turbinado.Environment