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

diegoeche · Nov 26, 2008 · a5a308d · a5a308d
2 parents a450314 + 4e7b973
commit a5a308d
Show file tree

Hide file tree

Showing 7 changed files with 101 additions and 46 deletions.
diff --git a/App/Controllers/Page.hs b/App/Controllers/Page.hs
@@ -0,0 +1,16 @@
+index :: Controller ()
+index  = do pages <- quickQuery' "select * from page" []
+            return ()
+
+show :: Controller ()
+show  = do e <- getEnvironment
+           let id' = getSetting "id" e :: Maybe String
+           doIO $ debugM e $ "XXXXXXXX    id' = " ++ (Prelude.show 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''
+
+
diff --git a/App/Layouts/Default.hs b/App/Layouts/Default.hs
@@ -1,46 +1,58 @@
+import Control.Monad.Trans
+import Data.List
+import Data.Maybe
+import qualified Network.HTTP as HTTP
+import qualified Network.URI  as URI
+
 page :: View XML
 page = <html>
          <head>
            <% styleSheet "normalize" "screen" %>
-           <% styleSheet "jsddm" "screen" %>
+           <% styleSheet "pressurized" "screen" %>
            <% styleSheet "turbinado" "screen" %>
            <% javaScript "jquery" %>
            <% javaScript "jsddm" %>
            <% googleAnalytics "UA-6158816-1" %>
          </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>
+           <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/About"       "About" %>
+                 <% menuItem "/Home/Performance" "Performance" %>
+                 <% 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>
+
+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/Views/Page/Show.hs b/App/Views/Page/Show.hs
@@ -0,0 +1,4 @@
+page :: View XML
+page =  <div>
+          <% getViewDataValue "page-content" %>
+        </div>
diff --git a/Config/App.hs b/Config/App.hs
@@ -1,13 +1,36 @@
-module Config.App where
+module Config.App (
+  applicationPath,
+  applicationHost,
+  AppEnvironment (..),
+  newAppEnvironment,
+  databaseConnection,
+  Connection,
+  customPreFilters,
+  customPostFilters,
+  logLevel
+  ) where
 
 import System.Log.Logger
 
+-- Your favorite HDBC driver
+import Database.HDBC.PostgreSQL
+
 ----------------------------------------------------------------
 -- Environment settings
 ----------------------------------------------------------------
 applicationPath = ""
 applicationHost = "localhost:8080"
 
+data AppEnvironment = AppEnvironment
+newAppEnvironment = AppEnvironment
+
+----------------------------------------------------------------
+-- Database connection
+----------------------------------------------------------------
+databaseConnection :: Maybe (IO Connection)
+databaseConnection = Just $ connectPostgreSQL "host=localhost dbname=turbinado user=turbinado password=turbinado"
+
+
 ----------------------------------------------------------------
 -- RequestHandler Filter List additions
 ----------------------------------------------------------------

diff --git a/Turbinado/Environment/.ViewData.hs.swp b/Turbinado/Environment/.ViewData.hs.swp
diff --git a/Turbinado/Layout.hs b/Turbinado/Layout.hs
@@ -4,26 +4,27 @@ module Turbinado.Layout (
   javaScript,
   googleAnalytics
   ) where
-
+import Control.Monad.State
+import Control.Monad.Trans
 import Data.Maybe
 import Data.Dynamic
-import Turbinado.Environment
+import Turbinado.Environment.Types
 import Turbinado.Environment.CodeStore
 import Turbinado.Environment.Logger
 import Turbinado.Environment.Settings
 import Turbinado.View
 
 insertView :: View XML
 insertView = do e <- getEnvironment
-                let cs  = getCodeStore e
-                    cl  = getView e
-                doIO $ debugM e $ "    Layout: insertView : loading   " ++ (fst cl) ++ " - " ++ (snd cl)
-                c <- doIO $ retrieveCode e CTView cl
+                let cs  = fromJust $ getCodeStore e
+                cl <- lift getView
+                --debugM $ "    Layout: insertView : loading   " ++ (fst cl) ++ " - " ++ (snd cl)
+                c <- lift $ retrieveCode CTView cl
                 case c of
                   CodeLoadView       v _ _ -> v 
                   CodeLoadController _ _ _ -> error "retrieveAndRunLayout called, but returned CodeLoadController"
-                  CodeLoadFailure          -> return $ cdata $ "CodeLoadFailure: insertView : " ++ (show $ fst $ getView e) ++ " - " ++ (show $ snd $ getView e)
-
+                  CodeLoadFailure          -> return $ cdata $ "CodeLoadFailure: insertView "
+                  
 styleSheet :: String -> String -> View XML
 styleSheet s m = return $ cdata $ "<link media=\"" ++ m ++"\" type=\"text/css\" rel=\"stylesheet\" href=\"/css/" ++ s ++".css\">"
 

diff --git a/turbinado.cabal b/turbinado.cabal
@@ -10,9 +10,8 @@ Build-Type:          Simple
 
 Executable server
   Main-is:             Turbinado/Server.hs
-  Build-Depends:       base, bytestring, containers, directory, filepath, harp, hslogger, hsx, HTTP, mtl, network, old-locale, old-time, parsec, plugins, pretty, regex-compat, time
-  Hs-Source-Dirs:      . , config
-  ghc-options: -F -pgmFtrhsx -O 
+  Build-Depends:       base, bytestring, containers, directory, filepath, harp, HDBC, HDBC-postgresql, hslogger, hsx, HTTP, mtl, network, old-locale, old-time, pandoc, parsec, plugins, pretty, regex-compat, time
+  ghc-options: -F -pgmFtrhsx -O
   Extensions: MultiParamTypeClasses,
             FunctionalDependencies,
             TypeFamilies,