Merge branch 'master' of git://github.com/alsonkemp/turbinado-website

Conflicts: App/Controllers/Page.hs App/Layouts/Default.hs App/Models/Bases/PageModelBase.hs App/Views/Develop/Index.hs
alsonkemp · Jan 17, 2009 · 0b2243f · 0b2243f
2 parents 83171d2 + 92bb239
commit 0b2243f
Show file tree

Hide file tree

Showing 304 changed files with 34,107 additions and 632 deletions.
diff --git a/App/Components/.gitignore b/App/Components/.gitignore
diff --git a/App/Components/Controllers/.gitignore b/App/Components/Controllers/.gitignore
diff --git a/App/Components/Controllers/Page.hs b/App/Components/Controllers/Page.hs
@@ -0,0 +1,17 @@
+import App.Models.PageModel
+
+show :: Controller ()
+show  = do id'  <- getSetting_u "id"
+           p <- find id'
+           setViewDataValue "page-title" (title p)
+           setViewDataValue "page-content" (content p)
+
+list :: Controller ()
+list  = do pages <- findAllOrderBy "_id"
+           setViewDataValue "component-pages-list" $ map (\p -> (title p, _id p)) pages
+
+listOnly :: Controller ()
+listOnly = do prefix <- getSetting_u "pages-prefix" :: Controller String
+              pages <- findAllWhereOrderBy "_id like ?" [toSql $ prefix ++ "%"] "_id"
+              setViewDataValue "component-pages-list" $ map (\p -> (title p, _id p)) pages
+              setSetting "component-view" "List" -- use the view from the List action
diff --git a/App/Components/Controllers/Test.hs b/App/Components/Controllers/Test.hs
@@ -0,0 +1,2 @@
+test :: Controller ()
+test = return ()
diff --git a/App/Components/Views/.gitignore b/App/Components/Views/.gitignore
diff --git a/App/Components/Views/Page/List.hs b/App/Components/Views/Page/List.hs
@@ -0,0 +1,16 @@
+markup= <div class="page-listing">
+          <h1>
+            Pages
+          </h1>
+          <% do l <- getViewDataValue_u "component-pages-list" :: View [(String, String)]
+                mapM indexItem l 
+          %>
+        </div>
+
+indexItem (t,i) = return $ cdata $ unlines $
+                   ["<div style='padding: 0pt 5px;'>"
+                   ," <a href=\"" ++ i ++"\">"
+                   ,"  "++ t
+                   ," </a>"
+                   ,"</div>"
+                   ]
diff --git a/App/Components/Views/Page/Show.hs b/App/Components/Views/Page/Show.hs
@@ -0,0 +1,5 @@
+markup = <div class="page-content">
+           <h1><% getViewDataValue_u "page-title" :: View String %></h1>
+           <% (getViewDataValue_u "page-content" :: View String) >>= (return . cdata) %>
+         </div>
+
diff --git a/App/Components/Views/Test/Test.hs b/App/Components/Views/Test/Test.hs
@@ -0,0 +1,3 @@
+markup = <div>
+           test
+         </div>
diff --git a/App/Controllers/Architecture.hs b/App/Controllers/Architecture.hs
@@ -0,0 +1,5 @@
+
+show :: Controller ()
+show = return () 
+
+
diff --git a/App/Controllers/Page.hs b/App/Controllers/Page.hs
@@ -1,58 +1,41 @@
 import App.Models.PageModel
+import qualified Network.URI as URI
 
 index :: Controller ()
-index  = do conn <- liftIO $ fromJust $ databaseConnection
-            pages <- liftIO $ findAll conn
+index  = do pages <- findAll
             setViewDataValue "pages-list" $ map (\p -> (title p, _id p)) pages
 
 show :: Controller ()
-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)
+show  = do id'  <- getSetting_u "id"
+           p <- find id'
+           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 setViewDataValue "save-url" ("/Page/Create/" ++ i)
+new  = do  id'  <- getSetting_u "id"
+           setViewDataValue "save-url" ("/Page/Create/" ++ id')
 
 create :: Controller ()
-create = do conn <- liftIO $ fromJust $ databaseConnection
-            e    <- get
-            id'  <- getSetting "id"
+create = do id'  <- getSetting_u "id"
             _title   <- getParam_u "title"
             _content <- getParam_u "content"
-            case id' of
-              Nothing -> redirectTo "/Home"
-              Just i  -> do App.Models.PageModel.insert conn Page {_id = i, title = _title, content = _content}
-                            redirectTo $ "/Page/Show/" ++ i
+            App.Models.PageModel.insert Page {_id = id', title = _title, content = _content} False
+            redirectTo $ "/Page/Show/" ++ id'
+
 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)
+edit  = do id'  <- getSetting_u "id"
+           p <- find id'
+           setViewDataValue "save-url" ("/Page/Save/" ++ id')
+           setViewDataValue "page-title" (title p)
+           setViewDataValue "page-content" (content p)
 
 save :: Controller ()
-save = do   conn <- liftIO $ fromJust $ databaseConnection
-            e    <- get
-            id'  <- getSetting "id"
+save = do   id'  <- getSetting_u "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
-    
+            p <- find id'
+            App.Models.PageModel.update p {title = _title, content = _content}
+            redirectTo $ "/Page/Show/" ++ id'
+
+
+
diff --git a/App/Controllers/Tutorial.hs b/App/Controllers/Tutorial.hs
@@ -1,5 +1,5 @@
 
-index :: Controller ()
-index = return () 
+show :: Controller ()
+show = return () 
 
 
diff --git a/App/Layouts/Default.hs b/App/Layouts/Default.hs
@@ -4,59 +4,60 @@ import Data.Maybe
 import qualified Network.HTTP as HTTP
 import qualified Network.URI  as URI
 
-page = <html>
-         <head>
-           <meta name="verify-v1" content="w8VesxPmDH0sX71+bZUok+LyY0eDG5aM6v8odpbkEm8=" />
-           <title>Turbinado: MVC Framework for Haskell</title>
-           <meta name="keywords" content="turbinado, haskell, mvc, model, view, controller, ruby, rails"> </meta>
-           <meta name="description" content="Turbinado is a Model-View-Controller-ish web framework written in Haskell.  Ruby On Rails comes to Haskell."> </meta>
-           <% styleSheet "normalize" "screen" %>
-           <% styleSheet "pressurized" "screen" %>
-           <% styleSheet "turbinado" "screen" %>
-           <% javaScript "jquery" %>
-           <% javaScript "jsddm" %>
-           <% googleAnalytics "UA-6158816-1" %>
-         </head>
-         <body>
-           <div id="wrapper">
-             <div id="header">
-               <div id="logo">
-                 <h1>
-                   <a href="http://www.turbinado.org">
-                     <img src="/images/turbinado.jpg" />
-                     <span style="left:140px; position:absolute; top:65px;">
-                       Turbinado
-                     </span>
-                   </a>
-                 </h1>
-               </div>
-             </div>
-             <div id="menu">
-               <ul>
-                 <% 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">
-               <div id="content">
-                 <% insertView %>
-               </div>
-             </div>
-             <div style="clear: both;" />
-           </div>
-           <div id="footer">
-             <p>Copyright (c) 2008 Turbinado.org. All rights reserved.</p>
-             <p>Design by <a href="http://www.freecsstemplates.org/">Free CSS Templates</a>.</p>
-           </div>
-         </body>
-       </html>
+markup = <html>
+          <head>
+            <meta name="verify-v1" content="w8VesxPmDH0sX71+bZUok+LyY0eDG5aM6v8odpbkEm8=" />
+            <title>Turbinado: MVC Framework for Haskell</title>
+            <meta name="keywords" content="turbinado, haskell, mvc, model, view, controller, ruby, rails"> </meta>
+            <meta name="description" content="Turbinado is a Model-View-Controller-ish web framework written in Haskell.  Ruby On Rails comes to Haskell."> </meta>
+            <% styleSheet "normalize" "screen" %>
+            <% styleSheet "pressurized" "screen" %>
+            <% styleSheet "turbinado" "screen" %>
+            <% javaScript "jquery" %>
+            <% javaScript "jsddm" %>
+            <% googleAnalytics "UA-6158816-1" %>
+          </head>
+          <body>
+            <div id="wrapper">
+              <div id="header">
+                <div id="logo">
+                  <h1>
+                    <a href="http://www.turbinado.org">
+                      <img src="/images/turbinado.jpg" />
+                      <span style="left:140px; position:absolute; top:65px;">
+                        Turbinado
+                      </span>
+                    </a>
+                  </h1>
+                </div>
+              </div>
+              <div id="menu">
+                <ul>
+                  <% menuItem "/Home/Index"                      "Home" %>
+                  <% menuItem "/Home/Performance"                "Performance" %>
+                  <% menuItem "/Architecture/Show/architecture"  "Architecture" %>
+                  <% menuItem "/Home/Install"                    "Install" %>
+                  <% menuItem "/Tutorial/Show/tutorial"          "Tutorial" %>
+                  <% menuItem "/Develop/Index"                   "Develop" %>
+                </ul>
+              </div>
+              <div id="page">
+                <div id="view">
+                  <% insertDefaultView %>
+                </div>
+              </div>
+              <div style="clear: both;" />
+            </div>
+            <div id="footer">
+              <p>Copyright (c) 2008 Turbinado.org. All rights reserved.</p>
+              <p>Design by <a href="http://www.freecsstemplates.org/">Free CSS Templates</a>.</p>
+            </div>
+          </body>
+         </html>
 
 menuItem :: FilePath -> String -> View XML
 menuItem p t = do e <- getEnvironment
                   let ru = HTTP.rqURI $ fromJust $ getRequest e
                       active = if isPrefixOf p (URI.uriPath ru) then "active" else ""
                   <li class=active><a href=p><%t%></a></li>
+
diff --git a/App/Layouts/Default.hs.old b/App/Layouts/Default.hs.old