Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

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

  • Loading branch information...
commit a5a308d50d0992777a82d78a0f7472f51ed74a81 2 parents a450314 + 4e7b973
@alsonkemp authored
View
16 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''
+
+
View
80 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>
View
4 App/Views/Page/Show.hs
@@ -0,0 +1,4 @@
+page :: View XML
+page = <div>
+ <% getViewDataValue "page-content" %>
+ </div>
View
25 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
----------------------------------------------------------------
View
BIN  Turbinado/Environment/.ViewData.hs.swp
Binary file not shown
View
17 Turbinado/Layout.hs
@@ -4,10 +4,11 @@ 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
@@ -15,15 +16,15 @@ 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\">"
View
5 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,
Please sign in to comment.
Something went wrong with that request. Please try again.