Permalink
Browse files

Git is killing me...

  • Loading branch information...
1 parent efee760 commit b7d4264a6f811b311a10cce46de7b004daf25bf6 @alsonkemp committed Mar 13, 2009
View
2 App/Controllers/Develop.hs
@@ -1,3 +1,5 @@
+module App.Controllers.Develop where
+
import Turbinado.Controller
index :: Controller ()
View
2 App/Controllers/Home.hs
@@ -1,3 +1,5 @@
+module App.Controllers.Home where
+
import Turbinado.Controller
index :: Controller ()
View
13 App/Layouts/Default.hs
@@ -1,3 +1,6 @@
+module App.Layouts.Default where
+
+import Turbinado.Layout
import Control.Monad.Trans
import Data.List
import Data.Maybe
@@ -10,11 +13,11 @@ markup = <html>
<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" %>
+ <% styleSheetTag "normalize" "screen" %>
+ <% styleSheetTag "pressurized" "screen" %>
+ <% styleSheetTag "turbinado" "screen" %>
+ <% javaScriptFile "jquery" %>
+ <% javaScriptFile "jsddm" %>
<% googleAnalytics "UA-6158816-1" %>
</head>
<body>
View
3 App/Views/Develop/Index.hs
@@ -1,3 +1,6 @@
+module App.Views.Develop.Index where
+import Turbinado.View
+
markup = <div>
<h2>! Windows</h2>
<p>This software doesn't work on Windows. Linux/Unix only at this point.</p>
View
4 App/Views/Home/Index.hs
@@ -1,3 +1,7 @@
+module App.Views.Home.Index where
+import Turbinado.View
+
+markup :: View XML
markup= <div>
<h1>Turbinado?</h1>
<div style="float:right">
View
6 Config/App.hs
@@ -1,6 +1,4 @@
module Config.App (
- applicationPath,
- applicationHost,
useLowerCasePaths,
Connection,
customSetupFilters,
@@ -21,15 +19,13 @@ import Turbinado.Environment.Session.CookieSession
----------------------------------------------------------------
-- Environment settings
----------------------------------------------------------------
-applicationPath = ""
-applicationHost = "localhost:8080"
-- | Determines whether the server uses URLs of the form FooBar/BimBam or foo_bar/bim_bam.
-- The Controllers and Views must still be named FooBar.hs and BimBam.hs.
useLowerCasePaths = True
----------------------------------------------------------------
--- Session stuff
+-- Session settings
----------------------------------------------------------------
sessionOpts = [ ("cookie-name", "turb-sess")
, ("cipher-key", "super secret phrase")
View
30 Config/Routes.hs
@@ -1,9 +1,39 @@
module Config.Routes where
+--
+-- Import modules for which you'll be creating static routes.
+--
+import App.Layouts.Default
+import App.Controllers.Home
+import App.Controllers.Develop
+import App.Views.Home.Index
+import App.Views.Develop.Index
+
+--
+-- Configure dynamic routes for on-the-fly compiled-and-loaded
+-- modules (ala Rails)
+--
routes = [ "/:controller/:action/:id.:format"
, "/:controller/:action/:id"
, "/:controller/:action.:format"
, "/:controller/:action"
, "/:controller"
, "/home"
]
+
+--
+-- Statically compile and load these Layouts, Controllers and Views
+--
+staticLayouts =
+ [ ("App/Layouts/Default.hs", "markup", App.Layouts.Default.markup)
+ ]
+
+staticControllers =
+ [ ("App/Controllers/Home.hs", "index", App.Controllers.Home.index)
+ , ("App/Controllers/Develop.hs", "index", App.Controllers.Develop.index)
+ ]
+
+staticViews =
+ [ ("App/Views/Home/Index.hs", "markup", App.Views.Home.Index.markup)
+ , ("App/Views/Develop/Index.hs", "markup", App.Views.Develop.Index.markup)
+ ]
View
13 Turbinado/Environment/CodeStore.hs
@@ -36,7 +36,8 @@ import Turbinado.Controller.Monad
-- | Create a new store for Code data
addCodeStoreToEnvironment :: (HasEnvironment m) => m ()
addCodeStoreToEnvironment = do e <- getEnvironment
- mv <- liftIO $ newMVar $ empty
+ let cm = empty
+ mv <- liftIO $ newMVar cm
setEnvironment $ e {getCodeStore = Just $ CodeStore mv}
-- | This function attempts to pull a function from a pre-loaded cache or, if
@@ -199,9 +200,13 @@ customMergeToDir stb src dir = do
MergeFailure ["Source file does not exist : "++stb]
_ -> do
src_str <- liftIO $ readFile src
- stb_str <- liftIO $ readFile stb
- let (stbimps, stbdecls) = span ( not . isPrefixOf "-- SPLIT HERE") $ lines stb_str
- mrg_str = outTitle ++ (unlines stbimps) ++ src_str ++ (unlines stbdecls)
+ stb_str <- liftIO $ readFile stb
+ -- Check to see whether the file start with "module ". If so, the user
+ -- should already have added the require preamble. Otherwise, merge the stub.
+ let mrg_str = case src_str of
+ ('m':'o':'d':'u':'l':'e':' ':_) -> src_str
+ _ -> let (stbimps, stbdecls) = span ( not . isPrefixOf "-- SPLIT HERE") $ lines stb_str
+ in outTitle ++ (unlines stbimps) ++ src_str ++ (unlines stbdecls)
liftIO $ createDirectoryIfMissing True outDir
hdl <- liftIO $ openFile outFile WriteMode -- overwrite!
liftIO $ hPutStr hdl mrg_str
View
28 Turbinado/Environment/Routes.hs
@@ -2,15 +2,18 @@ module Turbinado.Environment.Routes (
addRoutesToEnvironment,
runRoutes
) where
-
+
+import Control.Concurrent.MVar
import Text.Regex
import Data.Maybe
import Data.Typeable
import Data.Dynamic
import qualified Data.Map as M
+import Data.Time
import Control.Monad
import qualified Network.HTTP as HTTP
import qualified Network.URI as URI
+import Turbinado.Controller.Monad
import Turbinado.Controller.Exception
import Turbinado.Environment.Types
import Turbinado.Environment.Logger
@@ -23,7 +26,13 @@ import qualified Config.Routes
addRoutesToEnvironment :: (HasEnvironment m) => m ()
addRoutesToEnvironment = do e <- getEnvironment
- setEnvironment $ e {getRoutes = Just $ Routes $ parseRoutes Config.Routes.routes}
+ let CodeStore mv = fromJust' "Turbinado.Environment.Routes.addRoutesToEnvironment : no CodeStore" $ getCodeStore e
+ cm <- liftIO $ takeMVar mv
+ let cm' = addStaticControllers Config.Routes.staticControllers cm
+ cm'' = addStaticViews (Config.Routes.staticViews ++ Config.Routes.staticLayouts) cm'
+ liftIO $ putMVar mv cm''
+ setEnvironment $ e {
+ getRoutes = Just $ Routes $ parseRoutes Config.Routes.routes}
------------------------------------------------------------------------------
@@ -74,3 +83,18 @@ splitOn c l = reverse $ worker c l []
worker c (l:ls) (r:rs) = if (l == c)
then worker c ls ([]:r:rs)
else worker c ls ((r++[l]):rs)
+
+
+----------------------------------------------------------------------------
+-- Handle static routes
+----------------------------------------------------------------------------
+
+--addStaticViews :: [(String, String, View XML)] -> CodeMap -> CodeMap
+addStaticViews [] cm = cm
+addStaticViews ((p,f,v):vs) cm = let cm' = M.insert (p,f) (CodeLoadView v $ UTCTime (ModifiedJulianDay 1000000) (secondsToDiffTime 0)) cm in
+ addStaticViews vs cm'
+
+addStaticControllers [] cm = cm
+addStaticControllers ((p,f,c):cs) cm = let cm' = M.insert (p,f) (CodeLoadController c $ UTCTime (ModifiedJulianDay 1000000) (secondsToDiffTime 0)) cm in
+ addStaticControllers cs cm'
+
View
7 Turbinado/Layout/Helpers/Misc.hs
@@ -5,9 +5,8 @@ module Turbinado.Layout.Helpers.Misc (
import Turbinado.View
googleAnalytics :: String -> View XML
-googleAnalytics g = ( javaScript $
+googleAnalytics g = javaScriptBlock $
" 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\")); ") ++
- ( javaScript $
+ " document.write(unescape(\"%3Cscript src='\" + gaJsHost + \"google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E\")); " ++
" var pageTracker = _gat._getTracker(\"" ++ g ++ "\"); " ++
- " pageTracker._trackPageview(); ")
+ " pageTracker._trackPageview(); "
View
33 Turbinado/Server/Network.hs
@@ -42,12 +42,11 @@ sendResponse (Just sock) e = respondHTTP sock $ fromJust' "Network : sendRespons
acceptCGI :: Controller ()
acceptCGI = do body <- liftIO $ hGetContents stdin
hdrs <- liftIO $ Env.getEnvironment
- let rqheaders = parseHeaders $ map (\(a,b) -> a ++ ":" ++ b) hdrs
- rquri = fromJust $ parseURI "http://www.turbinado.org"
- rqmethod = GET
- emergencyM $ "acceptCGI body : " ++ body ++ "\n\n"
- emergencyM $ "acceptCGI hdrs : " ++ (show hdrs) ++ "\n\n"
- emergencyM $ "acceptCGI rqheaders : " ++ (show rqheaders) ++ "\n\n"
+ let rqheaders = parseHeaders $ extractHTTPHeaders hdrs
+ rquri = fromJust' "Network: acceptCGI: parseURI failed" $ parseURI $
+ fromJust' "Network: acceptCGI: No REQUEST_URI in hdrs" $ lookup "SCRIPT_URI" hdrs
+ rqmethod = fromJust' "Network: acceptCGI: REQUEST_METHOD invalid" $ flip lookup rqMethodMap $
+ fromJust' "Network: acceptCGI: No REQUEST_METHOD in hdrs" $ lookup "REQUEST_METHOD" hdrs
case rqheaders of
Left err -> errorResponse $ show err
Right r -> do e' <- getEnvironment
@@ -73,3 +72,25 @@ respondCGI :: Response -> IO ()
respondCGI r = do let message = (unlines $ drop 1 $ lines $ show r) ++ "\n\n" ++ rspBody r -- need to drop the first line from the response for CGI
hPutStr stdout message
hFlush stdout
+
+-- | Convert from HTTP_SOME_FLAG to Some-Flag for HTTP.parseHeaders
+extractHTTPHeaders :: [(String, String)] -> [String]
+extractHTTPHeaders [] = []
+extractHTTPHeaders (('H':'T':'T':'P':'_':k,v):hs) = (convertUnderscores k ++ ": " ++ v) : extractHTTPHeaders hs
+ where convertUnderscores [] = []
+ convertUnderscores ('_':ss) = '-' : convertUnderscores ss
+ convertUnderscores (s :ss) = s : convertUnderscores ss
+extractHTTPHeaders ((k,v) : hs) = extractHTTPHeaders hs
+
+
+-- | Lifted from Network.HTTP
+rqMethodMap :: [(String, RequestMethod)]
+rqMethodMap = [("HEAD", HEAD),
+ ("PUT", PUT),
+ ("GET", GET),
+ ("POST", POST),
+ ("DELETE", DELETE),
+ ("OPTIONS", OPTIONS),
+ ("TRACE", TRACE)]
+
+
View
2 Turbinado/View.hs
@@ -11,6 +11,7 @@ module Turbinado.View (
insertComponent,
-- Module Exports
+ module Turbinado.View.Helpers,
module Turbinado.View.HTML,
module Turbinado.View.XML,
module Turbinado.View.XML.PCDATA,
@@ -47,6 +48,7 @@ import Turbinado.Environment.Types
import Turbinado.Environment.ViewData
import Turbinado.Server.StandardResponse
import Turbinado.View.Exception
+import Turbinado.View.Helpers
import Turbinado.View.HTML
import Turbinado.View.Monad hiding (liftIO)
import Turbinado.View.XML hiding (Name)
View
7 Turbinado/View/Helpers/Misc.hs
@@ -8,8 +8,11 @@ import qualified Network.URI as URI
import qualified Network.HTTP as HTTP
import System.FilePath
-
-import Turbinado.View
+import Turbinado.Environment.Types
+import Turbinado.Environment.Request
+import Turbinado.View.Monad
+import Turbinado.View.XML
+import Turbinado.View.XMLGenerator
breadCrumbs :: View XML
breadCrumbs = do e <- getEnvironment
View
4 Turbinado/View/Helpers/Tags.hs
@@ -4,7 +4,9 @@ module Turbinado.View.Helpers.Tags (
javaScriptBlock
) where
-import Turbinado.View
+import Turbinado.View.Monad
+import Turbinado.View.XML
+import Turbinado.View.XMLGenerator
anchorTag :: String -> String -> View XML
anchorTag l t = <a href=l><% t %></a>
View
2 turbinado.cabal
@@ -1,5 +1,5 @@
Name: turbinado
-Version: 0.5.5
+Version: 0.6.0
Synopsis: Haskell web application server
Description: The Haskell web application server
License: BSD3

0 comments on commit b7d4264

Please sign in to comment.