Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Fixing trturbinado parsers; adding HelloWorld.

  • Loading branch information...
commit 2219fb35229e76b090536fdc4010bbe361a3a6dc 1 parent ec49704
Alson Kemp authored June 09, 2009
7  App/Controllers/HelloWorld.hs
... ...
@@ -0,0 +1,7 @@
  1
+module App.Controllers.HelloWorld where
  2
+
  3
+import Turbinado.Controller
  4
+
  5
+index :: Controller ()
  6
+index = do setViewDataValue "sample_value" "smarfle!"
  7
+
33  App/Views/HelloWorld/Index.hs
... ...
@@ -0,0 +1,33 @@
  1
+module App.Views.HelloWorld.Index where
  2
+import Turbinado.View
  3
+
  4
+markup :: VHtml
  5
+markup=
  6
+  <div>
  7
+    <% someTextXHtml %>
  8
+    <% someHtml %>
  9
+    <% someHAML %>
  10
+  </div>
  11
+
  12
+-- | These are the raw Turbinado.View.Html style tags
  13
+someTextXHtml :: VHtml
  14
+someTextXHtml = do s <- getViewDataValue_u "sample_value" :: View String
  15
+                   ((tag "div") (
  16
+                    ((tag "i") (stringToVHtml s)) +++
  17
+                    ((tag "b") (stringToVHtml "some text in Turbinado.View.Html style"))
  18
+                    )) 
  19
+                    
  20
+someHtml :: VHtml
  21
+someHtml = do s <- getViewDataValue_u "sample_value" :: View String
  22
+              <div>
  23
+                <i><%= s %></i>
  24
+                <b>some text in XHtml style</b>
  25
+              </div>
  26
+
  27
+someHAML :: VHtml
  28
+someHAML = do s <- getViewDataValue_u "sample_value" :: View String
  29
+              %div
  30
+                %i= s
  31
+                %b some text in HAML style
  32
+
  33
+
1  Config/Master.hs
@@ -19,6 +19,7 @@ compileArgs =
19 19
         , "-odir " ++ compiledDir
20 20
         , "-hidir " ++ compiledDir
21 21
         , "-package HDBC"
  22
+        -- , "-keep-tmp-files"
22 23
         , "-O"
23 24
         ]
24 25
 
29  Turbinado/PreProcessor/Parser/HAML.hs
@@ -36,22 +36,19 @@ commaSep1 = T.commaSep1 hamlLexer
36 36
 -- A Block always starts with some whitespace, then has a valid bit of data
37 37
 hamlBlock   = do whiteSpace
38 38
                  currentPos <- getPosition
39  
-                 bs <- manyTill1
40  
-                      (try pTag <|> pText <?> "tag or text")
41  
-                      (shallower currentPos)
42  
-                 return $ intercalate "+++\n" bs
  39
+                 bs <- (try pTag) <|> pText <?> "tag or text"
  40
+                 return bs
43 41
 
44 42
 pTag    = do    currentPos <- getPosition
45  
-                try
46  
-                    (do t  <- lexeme tagParser <?> "tag"
47  
-                        ts <- ((closeTag currentPos <|> eol) >> return []) <|>
48  
-                              (try hamlBlock) <|>
49  
-                              (blankLine) <?> "closing tag, block or blankLine in pTag"
50  
-                        return $ intercalate "\n" $ filter (not . null) $
  43
+                t  <- lexeme tagParser <?> "tag"
  44
+                nc <- optionMaybe $ closeTag currentPos
  45
+                ts <- if (isJust nc)
  46
+                                then return []
  47
+                                else manyTill1 hamlBlock (shallowerOrEqual currentPos)
  48
+                return $ intercalate "\n" $ filter (not . null) $
51 49
                           [ (indent currentPos) ++ "((" ++ (if (null ts) then "i" else "") ++ t  ++ ")"
52  
-                          , if null ts then [] else ts
  50
+                          , if (not $ null ts) then (indent currentPos ++ " (\n" ++ (intercalate "+++\n" ts ) ++ ")") else ""
53 51
                           , (indent currentPos) ++ " )"]
54  
-                    )
55 52
 
56 53
 pText = lexeme stringParser
57 54
 closeTag p = isInline p >> char '/'
@@ -135,6 +132,14 @@ shallower p     = (eof >> return []) <|>
135 132
                                 False -> pzero
136 133
                   )
137 134
 
  135
+shallowerOrEqual p = 
  136
+                  (eof >> return []) <|> 
  137
+                  (do innerPos <- getPosition
  138
+                      case (sourceColumn innerPos) <= (sourceColumn p) of
  139
+                                True  -> return []
  140
+                                False -> pzero
  141
+                  )
  142
+
138 143
 deeper p        = (eof >> return []) <|> 
139 144
                   (do innerPos <- getPosition
140 145
                       case (sourceColumn innerPos) > (sourceColumn p) of
4  Turbinado/PreProcessor/Parser/XHTML.hs
@@ -48,7 +48,7 @@ xhtmlBlock :: CharParser () String
48 48
 xhtmlBlock  = do whiteSpace
49 49
                  currentPos <- getPosition
50 50
                  bs <- (try pTag) <|> (try pPrintCode) <|> (try pCode) <|> pText
51  
-                 return $ bs
  51
+                 return  bs
52 52
 
53 53
 pTag :: CharParser () String
54 54
 pTag    = do    currentPos <- getPosition
@@ -58,7 +58,7 @@ pTag    = do    currentPos <- getPosition
58 58
                           else (manyTill1 xhtmlBlock (fromJust ctag))
59 59
                 return $ intercalate "\n" $ filter (not . null) $
60 60
                           [ (indent currentPos) ++ "((" ++ t  ++ ")"
61  
-                          , if (not $ null ts) then (indent currentPos ++ "(\n" ++ (intercalate "+++\n" ts ) ++ ")") else ""
  61
+                          , if (not $ null ts) then (indent currentPos ++ " (\n" ++ (intercalate "+++\n" ts ) ++ ")") else ""
62 62
                           , (indent currentPos) ++ " )"
63 63
                           ]
64 64
                 <?> "tag for pTag"
2  Turbinado/Server/RequestProcess.hs
@@ -93,7 +93,7 @@ retrieveAndRunController =
93 93
 
94 94
 -- | This function dynamically loads (if needed) the 'View'
95 95
 -- using the information provided by the 'Routes'.  Views reside
96  
--- in @App/Views@ and Layouts reside in @App/Layouts.  
  96
+-- in @App/Views@ and Layouts reside in @App/Layouts@.  
97 97
 -- The 'View' must contain a @markup@ function.
98 98
 -- The first 'View' loaded is usually the Layout, which itself
99 99
 -- loads the actual 'View'.  If the @layout@ setting is empty, then

0 notes on commit 2219fb3

Please sign in to comment.
Something went wrong with that request. Please try again.