Permalink
Browse files

Updating the ORM; Adding a mini-CMS; Adding a little HAML translator

  • Loading branch information...
1 parent 9a9af21 commit a1aa2cd5e2e2c18cefb93572b5f0bbdfbf22f87b @alsonkemp committed Dec 11, 2008
Showing with 916 additions and 236 deletions.
  1. +6 −3 App/Controllers/Home.hs
  2. +51 −9 App/Controllers/Page.hs
  3. +6 −6 App/Layouts/Default.hs
  4. +53 −0 App/Layouts/Default.hs.old
  5. +114 −0 App/Layouts/index.html
  6. +5 −0 App/Models/AuthorModel.hs
  7. BIN App/Models/Bases/.PageModelBase.hs.swp
  8. +58 −0 App/Models/Bases/AuthorModelBase.hs
  9. +36 −0 App/Models/Bases/ModelBase.hs
  10. +58 −0 App/Models/Bases/PageModelBase.hs
  11. +5 −0 App/Models/PageModel.hs
  12. +8 −30 App/Views/Develop/Index.hs
  13. +0 −21 App/Views/Home/About.hs
  14. +4 −0 App/Views/Home/Architecture.hs
  15. +0 −1 App/Views/Home/Hello.hs
  16. +19 −1 App/Views/Home/Index.hs
  17. +46 −0 App/Views/Home/Install.hs
  18. +0 −1 App/Views/Home/Performance.hs
  19. +15 −0 App/Views/Page/Edit.hs
  20. +15 −0 App/Views/Page/Index.hs
  21. +13 −0 App/Views/Page/New.hs
  22. +2 −2 App/Views/Page/Show.hs
  23. +0 −1 App/Views/Tutorial/Index.hs
  24. +3 −3 Config/App.hs
  25. +3 −4 Config/Master.hs
  26. +5 −1 Turbinado/Controller.hs
  27. +14 −8 Turbinado/Database/ORM/Generator.hs
  28. +80 −58 Turbinado/Database/ORM/Output.hs
  29. +18 −1 Turbinado/Database/ORM/PostgreSQL.hs
  30. +2 −1 Turbinado/Database/ORM/Types.hs
  31. +0 −47 Turbinado/Environment.hs
  32. +17 −17 Turbinado/Environment/CodeStore.hs
  33. +15 −2 Turbinado/Environment/Header.hs
  34. +49 −0 Turbinado/Environment/Params.hs
  35. +1 −1 Turbinado/Environment/Types.hs
  36. +1 −0 Turbinado/Environment/ViewData.hs
  37. +3 −5 Turbinado/Layout.hs
  38. +13 −10 Turbinado/Server/Handlers/RequestHandler.hs
  39. +1 −0 Turbinado/Stubs/Layout.hs
  40. +3 −0 Turbinado/Stubs/View.hs
  41. +5 −1 Turbinado/View.hs
  42. +159 −0 Turbinado/View/HAML/trhaml.hs
  43. +1 −0 static/css/turbinado.css
  44. +9 −2 turbinado.cabal
View
@@ -2,12 +2,15 @@
index :: Controller ()
index = return ()
-about :: Controller ()
-about = return ()
-
performance :: Controller ()
performance = return ()
+install :: Controller ()
+install = return ()
+
+architecture :: Controller ()
+architecture= return ()
+
hello :: Controller ()
hello = clearLayout
View
@@ -1,16 +1,58 @@
+import App.Models.PageModel
+
index :: Controller ()
-index = do pages <- quickQuery' "select * from page" []
- return ()
+index = do conn <- liftIO $ fromJust $ databaseConnection
+ pages <- liftIO $ findAll conn
+ setViewDataValue "pages-list" $ map (\p -> (title p, _id p)) pages
show :: Controller ()
-show = do e <- getEnvironment
- let id' = getSetting "id" e :: Maybe String
- doIO $ debugM e $ "XXXXXXXX id' = " ++ (Prelude.show id')
+show = do conn <- liftIO $ fromJust $ databaseConnection
+ e <- get
+ id' <- getSetting "id"
+ case id' of
+ Nothing -> redirectTo "/Home"
+ Just i -> do p <- find conn i
+ setViewDataValue "page-title" (title p)
+ setViewDataValue "page-content" (content p)
+
+new :: Controller ()
+new = do conn <- liftIO $ fromJust $ databaseConnection
+ e <- get
+ id' <- getSetting "id"
case id' of
Nothing -> redirectTo "/Home"
- Just i -> do q <- quickQuery' "select title, content from page where id = ?" [toSql i]
- e' <- doIO $ setViewDataValue "page-title" (Prelude.show $ (head q) !! 0) e
- e''<- doIO $ setViewDataValue "page-content" (Prelude.show $ (head q) !! 1) e
- put e''
+ Just i -> do setViewDataValue "save-url" ("/Page/Create/" ++ i)
+create :: Controller ()
+create = do conn <- liftIO $ fromJust $ databaseConnection
+ e <- get
+ id' <- getSetting "id"
+ _title <- getParam_u "title"
+ _content <- getParam_u "content"
+ case id' of
+ Nothing -> redirectTo "/Home"
+ Just i -> do App.Models.PageModel.insert conn Page {authorId = Nothing,_id = i, title = _title, content = _content, version = 1}
+ redirectTo $ "/Page/Show/" ++ i
+edit :: Controller ()
+edit = do conn <- liftIO $ fromJust $ databaseConnection
+ e <- get
+ id' <- getSetting "id"
+ case id' of
+ Nothing -> redirectTo "/Home"
+ Just i -> do p <- find conn i
+ setViewDataValue "save-url" ("/Page/Save/" ++ i)
+ setViewDataValue "page-title" (title p)
+ setViewDataValue "page-content" (content p)
+save :: Controller ()
+save = do conn <- liftIO $ fromJust $ databaseConnection
+ e <- get
+ id' <- getSetting "id"
+ _title <- getParam_u "title"
+ _content <- getParam_u "content"
+ case id' of
+ Nothing -> redirectTo "/Home"
+ Just i -> do p <- find conn i
+ App.Models.PageModel.update conn p {title = _title, content = _content}
+ redirectTo $ "/Page/Show/" ++ i
+
View
@@ -4,7 +4,6 @@ import Data.Maybe
import qualified Network.HTTP as HTTP
import qualified Network.URI as URI
-page :: View XML
page = <html>
<head>
<% styleSheet "normalize" "screen" %>
@@ -30,11 +29,12 @@ page = <html>
</div>
<div id="menu">
<ul>
- <% menuItem "/Home/Index" "Home" %>
- <% menuItem "/Home/About" "About" %>
- <% menuItem "/Home/Performance" "Performance" %>
- <% menuItem "/Tutorial/Index" "Tutorial" %>
- <% menuItem "/Develop/Index" "Develop" %>
+ <% menuItem "/Home/Index" "Home" %>
+ <% menuItem "/Home/Performance" "Performance" %>
+ <% menuItem "/Home/Architecture" "Architecture" %>
+ <% menuItem "/Home/Install" "Install" %>
+ <% menuItem "/Tutorial/Index" "Tutorial" %>
+ <% menuItem "/Develop/Index" "Develop" %>
</ul>
</div>
<div id="page">
View
@@ -0,0 +1,53 @@
+page :: View XML
+page = <html>
+ <head>
+ <% styleSheet "normalize" "screen" %>
+ <% styleSheet "jsddm" "screen" %>
+ <% styleSheet "turbinado" "screen" %>
+ <% javaScript "jquery" %>
+ <% javaScript "jsddm" %>
+ <script type="text/javascript">
+ var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www.");
+ document.write(unescape("%3Cscript src='" + gaJsHost + "google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E"));
+ </script>
+ <script type="text/javascript">
+ var pageTracker = _gat._getTracker("UA-6158816-1");
+ pageTracker._trackViewview();
+ </script>
+ </head>
+ <body>
+ <table class="wrapper">
+ <tr>
+ <td class="title">
+ <h1>Turbinado</h1>
+ <img class="title-image" src="/images/turbinado.jpg" />
+ <h2>Sugar For</h2>
+ <h2>The Web</h2>
+ </td>
+ <td class="container">
+ <ul id="jsddm">
+ <li><a href="/Home/Index">Home</a>
+ <ul>
+ <li><a href="/Home/About">About</a></li>
+ <li><a href="/Home/Performance">Performance</a></li>
+ </ul>
+ </li>
+ <li><a href="/Tutorial/Index">Tutorial</a>
+ </li>
+ <li><a href="/Develop/Index">Develop</a></li>
+ </ul>
+ <div class="clear"></div>
+ <% breadCrumbs %>
+ <div id="content-block" class="content-block">
+ <% insertView %>
+ </div>
+ </td>
+ </tr>
+ <tr>
+ <td colspan="2">
+ <div class="footer">Turbinado - www.turbinado.org</div>
+ </td>
+ </tr>
+ </table>
+ </body>
+ </html>
View
@@ -0,0 +1,114 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<!--
+Design by Free CSS Templates
+http://www.freecsstemplates.org
+Released for free under a Creative Commons Attribution 2.5 License
+
+Name : Pressurized
+Description: A two-column, fixed-width design with dark color scheme.
+Version : 1.0
+Released : 20081103
+
+-->
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+<meta name="keywords" content="" />
+<meta name="description" content="" />
+<meta http-equiv="content-type" content="text/html; charset=utf-8" />
+<title>Pressurized by Free CSS Templates</title>
+<link href="style.css" rel="stylesheet" type="text/css" media="screen" />
+</head>
+<body>
+<div id="wrapper">
+ <div id="header">
+ <div id="logo">
+ <h1><a href="#">Pressurized </a></h1>
+ <p> design by <a href="http://www.freecsstemplates.org/">Free CSS Templates</a></p>
+ </div>
+ </div>
+ <!-- end #header -->
+ <div id="menu">
+ <ul>
+ <li class="first"><a href="#">Home</a></li>
+ <li><a href="#">Blog</a></li>
+ <li><a href="#">Photos</a></li>
+ <li><a href="#">About</a></li>
+ <li><a href="#">Links</a></li>
+ <li><a href="#">Contact</a></li>
+ </ul>
+ </div>
+ <!-- end #menu -->
+ <div id="page">
+ <div id="content">
+ <div class="post">
+ <h1 class="title"><a href="#">Welcome to Pressurized </a></h1>
+ <div class="entry">
+ <p>This is <strong>Pressurized</strong>, a free, fully standards-compliant CSS template designed by FreeCssTemplates<a href="http://www.nodethirtythree.com/"></a> for <a href="http://www.freecsstemplates.org/">Free CSS Templates</a>. The photo used in this design is from <a href="http://www.pdphoto.org/">PDPhoto.rog</a>. This free template is released under a <a href="http://creativecommons.org/licenses/by/2.5/">Creative Commons Attributions 2.5</a> license, so you’re pretty much free to do whatever you want with it (even use it commercially) provided you keep the links in the footer intact. Aside from that, have fun with it :)</p>
+ <p>Sed lacus. Donec lectus. Nullam pretium nibh ut turpis. Nam bibendum. In nulla tortor, elementum ipsum. Proin imperdiet est. Phasellus dapibus semper urna. Pellentesque ornare, orci in felis. Donec ut ante. In id eros. Suspendisse lacus turpis, cursus egestas at sem.</p>
+ </div>
+ <p class="meta">Posted by <a href="#">Someone</a> on March 10, 2008
+ &nbsp;&bull;&nbsp; <a href="#" class="comments">Comments (64)</a> &nbsp;&bull;&nbsp; <a href="#" class="permalink">Full article</a></p>
+ </div>
+ <div class="post">
+ <h2 class="title"><a href="#">Lorem ipsum sed aliquam</a></h2>
+ <div class="entry">
+ <p>Sed lacus. Donec lectus. Nullam pretium nibh ut turpis. Nam bibendum. In nulla tortor, elementum vel, tempor at, varius non, purus. Mauris vitae nisl nec metus placerat consectetuer. Donec ipsum. Proin imperdiet est. Phasellus <a href="#">dapibus semper urna</a>. Pellentesque ornare, orci in consectetuer hendrerit, urna elit eleifend nunc, ut consectetuer nisl felis ac diam. Etiam non felis. Donec ut ante. In id eros. Suspendisse lacus turpis, cursus egestas at sem. Phasellus pellentesque. Mauris quam enim, molestie in, rhoncus ut, lobortis a, est.</p>
+ <p>Praesent ac lectus. Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Vivamus augue. Fusce eget tellus ultrices ligula volutpat adipiscing. Aenean ligula lectus, vehicula in, dictum a, fermentum nec, felis. Nunc ac turpis in leo posuere imperdiet.</p>
+ </div>
+ <p class="meta">Posted by <a href="#">Someone</a> on March 8, 2008
+ &nbsp;&bull;&nbsp; <a href="#" class="comments">Comments (64)</a> &nbsp;&bull;&nbsp; <a href="#" class="permalink">Full article</a></p>
+ </div>
+ <div class="post">
+ <h2 class="title"><a href="#">Phasellus pellentesque turpis </a></h2>
+ <div class="entry">
+ <p>Sed lacus. Donec lectus. Nullam pretium nibh ut turpis. Nam bibendum. In nulla tortor, elementum vel, tempor at, varius non, purus. Mauris vitae nisl nec metus placerat consectetuer. Donec ipsum. Proin imperdiet est. Pellentesque ornare, orci in consectetuer hendrerit, urna elit eleifend nunc, ut consectetuer nisl felis ac diam. Etiam non felis. Donec ut ante. In id eros. Suspendisse lacus turpis, cursus egestas at sem. Phasellus pellentesque. Mauris quam enim molestie rhoncus lobortis a, est.</p>
+ </div>
+ <p class="meta">Posted by <a href="#">Someone</a> on March 8, 2008
+ &nbsp;&bull;&nbsp; <a href="#" class="comments">Comments (64)</a> &nbsp;&bull;&nbsp; <a href="#" class="permalink">Full article</a></p>
+ </div>
+ </div>
+ <!-- end #content -->
+ <div id="sidebar">
+ <ul>
+ <li>
+ <h2>Aliquam tempus</h2>
+ <p>Mauris vitae nisl nec metus placerat perdiet est. Phasellus dapibus semper urna ornare consectetuer hendrerit.</p>
+ </li>
+ <li>
+ <h2>Categories</h2>
+ <ul>
+ <li><a href="#">Uncategorized</a> (3)<span>Lorem Ipsum Dolor Sit Amit</span></li>
+ <li><a href="#">Lorem Ipsum</a> (42)<span>Lorem Ipsum Dolor Sit Amit</span></li>
+ <li><a href="#">Urna Congue Rutrum</a> (28)<span>Lorem Ipsum Dolor Sit Amit</span> </li>
+ <li><a href="#">Vivamus Fermentum</a> (13)<span>Lorem Ipsum Dolor Sit Amit</span> </li>
+ </ul>
+ </li>
+ <li>
+ <h2>Blogroll</h2>
+ <ul>
+ <li><a href="#">Phasellus Pellentesque</a><span>Lorem Ipsum Dolor Sit Amit</span> </li>
+ <li><a href="#">Consectetuer Adipiscing</a><span>Lorem Ipsum Dolor Sit Amit</span> </li>
+ <li><a href="#">Urna Congue Rutrum</a><span>Lorem Ipsum Dolor Sit Amit</span> </li>
+ </ul>
+ </li>
+ <li>
+ <h2>Archives</h2>
+ <ul>
+ <li><a href="#">December 2007</a>&nbsp;(29)<span>Lorem Ipsum Dolor Sit Amit</span></li>
+ <li><a href="#">November 2007</a>&nbsp;(30)<span>Lorem Ipsum Dolor Sit Amit</span></li>
+ <li><a href="#">October 2007</a>&nbsp;(31)<span>Lorem Ipsum Dolor Sit Amit</span></li>
+ </ul>
+ </li>
+ </ul>
+ </div>
+ <!-- end #sidebar -->
+ <div style="clear: both;">&nbsp;</div>
+ </div>
+ <!-- end #page -->
+ <div id="footer">
+ <p>Copyright (c) 2008 Sitename.com. All rights reserved. Design by <a href="http://www.freecsstemplates.org/">Free CSS Templates</a>.</p>
+ </div>
+ <!-- end #footer -->
+</div>
+</body>
+</html>
@@ -0,0 +1,5 @@
+module App.Models.AuthorModel
+ ( module App.Models.AuthorModel
+ , module App.Models.Bases.AuthorModelBase
+ ) where
+import App.Models.Bases.AuthorModelBase
Binary file not shown.
@@ -0,0 +1,58 @@
+{- 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. App/Models/ExampleModel.hs) and
+ not into the base file (e.g. App/Models/Bases/ExampleModelBase.hs) -}
+
+module App.Models.Bases.AuthorModelBase (
+ module App.Models.Bases.AuthorModelBase,
+ module App.Models.Bases.ModelBase) where
+
+import App.Models.Bases.ModelBase
+import qualified Database.HDBC as HDBC
+import System.Time
+
+data Author = Author {
+ id :: Int64, name :: Maybe String
+ } deriving (Eq, Show)
+
+instance DatabaseModel Author where
+ tableName _ = "author"
+
+instance IsModel Author where
+ insert conn m = do
+ res <- liftIO $ HDBC.run conn " INSERT INTO author (id,name) VALUES (?,?)"
+ [HDBC.toSql $ id m , HDBC.toSql $ name m]
+ liftIO $ HDBC.commit conn
+ i <- liftIO $ HDBC.catchSql (HDBC.quickQuery' conn "SELECT lastval()" []) (\_ -> HDBC.commit conn >> (return $ [[HDBC.toSql (0 :: Int)]]) )
+ return $ HDBC.fromSql $ head $ head i
+ findAll conn = do
+ res <- liftIO $ HDBC.quickQuery' conn "SELECT id , name FROM author" []
+ return $ map (\r -> Author (HDBC.fromSql (r !! 0)) (HDBC.fromSql (r !! 1))) res
+ findAllBy conn ss sp = do
+ res <- liftIO $ HDBC.quickQuery' conn ("SELECT id , name FROM author WHERE (" ++ ss ++ ") ") sp
+ return $ map (\r -> Author (HDBC.fromSql (r !! 0)) (HDBC.fromSql (r !! 1))) res
+ findOneBy conn ss sp = do
+ res <- liftIO $ HDBC.quickQuery' conn ("SELECT id , name FROM author WHERE (" ++ ss ++ ") LIMIT 1") sp
+ return $ (\r -> Author (HDBC.fromSql (r !! 0)) (HDBC.fromSql (r !! 1))) (head res)
+instance HasFindByPrimaryKey Author (Int64) where
+ find conn pk@(pk1) = do
+ res <- liftIO $ HDBC.quickQuery' conn ("SELECT id , name FROM author WHERE (id = ? )") [HDBC.toSql pk1]
+ case res of
+ [] -> throwDyn $ HDBC.SqlError
+ {HDBC.seState = "",
+ HDBC.seNativeError = (-1),
+ HDBC.seErrorMsg = "No record found when finding by Primary Key:author : " ++ (show pk)
+ }
+ r:[] -> return $ Author (HDBC.fromSql (r !! 0)) (HDBC.fromSql (r !! 1))
+ _ -> throwDyn $ HDBC.SqlError
+ {HDBC.seState = "",
+ HDBC.seNativeError = (-1),
+ HDBC.seErrorMsg = "Too many records found when finding by Primary Key:author : " ++ (show pk)
+ }
+
+ update conn m = do
+ res <- liftIO $ HDBC.run conn "UPDATE author SET (id , name) = (?,?) WHERE (id = ? )"
+ [HDBC.toSql $ id m , HDBC.toSql $ name m, HDBC.toSql $ id m]
+ liftIO $ HDBC.commit conn
+ return ()
@@ -0,0 +1,36 @@
+{- DO NOT EDIT THIS FILE
+ THIS FILE IS AUTOMAGICALLY GENERATED AND YOUR CHANGES WILL BE EATEN BY THE GENERATOR OVERLORD -}
+
+module App.Models.Bases.ModelBase (
+ module App.Models.Bases.ModelBase,
+ module Control.Exception,
+ module Control.Monad.Trans,
+ module Data.Int
+ ) where
+
+import Control.Monad.Trans
+import Control.Exception
+import Database.HDBC
+import Data.Int
+
+import Turbinado.Controller.Monad
+
+-- Using phantom types here
+class DatabaseModel m where
+ tableName :: m -> String
+
+type SelectString = String
+type SelectParams = [SqlValue]
+
+class (DatabaseModel model) =>
+ IsModel model where
+ insert :: (MonadIO m, IConnection conn) => conn -> model -> m Integer
+ findAll :: (MonadIO m, IConnection conn) => conn -> m [model]
+ findAllBy :: (MonadIO m, IConnection conn) => conn -> SelectString -> SelectParams -> m [model]
+ findOneBy :: (MonadIO m, IConnection conn) => conn -> SelectString -> SelectParams -> m model
+
+class (DatabaseModel model) =>
+ HasFindByPrimaryKey model primaryKey | model -> primaryKey where
+ find :: (MonadIO m, IConnection conn) => conn -> primaryKey -> m model
+ update :: (MonadIO m, IConnection conn) => conn -> model -> m ()
+
Oops, something went wrong.

0 comments on commit a1aa2cd

Please sign in to comment.