Permalink
Browse files

Fixing trturbinado parsers; adding HelloWorld.

  • Loading branch information...
1 parent ec49704 commit 2219fb35229e76b090536fdc4010bbe361a3a6dc @alsonkemp committed Jun 10, 2009
@@ -0,0 +1,7 @@
+module App.Controllers.HelloWorld where
+
+import Turbinado.Controller
+
+index :: Controller ()
+index = do setViewDataValue "sample_value" "smarfle!"
+
@@ -0,0 +1,33 @@
+module App.Views.HelloWorld.Index where
+import Turbinado.View
+
+markup :: VHtml
+markup=
+ <div>
+ <% someTextXHtml %>
+ <% someHtml %>
+ <% someHAML %>
+ </div>
+
+-- | These are the raw Turbinado.View.Html style tags
+someTextXHtml :: VHtml
+someTextXHtml = do s <- getViewDataValue_u "sample_value" :: View String
+ ((tag "div") (
+ ((tag "i") (stringToVHtml s)) +++
+ ((tag "b") (stringToVHtml "some text in Turbinado.View.Html style"))
+ ))
+
+someHtml :: VHtml
+someHtml = do s <- getViewDataValue_u "sample_value" :: View String
+ <div>
+ <i><%= s %></i>
+ <b>some text in XHtml style</b>
+ </div>
+
+someHAML :: VHtml
+someHAML = do s <- getViewDataValue_u "sample_value" :: View String
+ %div
+ %i= s
+ %b some text in HAML style
+
+
View
@@ -19,6 +19,7 @@ compileArgs =
, "-odir " ++ compiledDir
, "-hidir " ++ compiledDir
, "-package HDBC"
+ -- , "-keep-tmp-files"
, "-O"
]
@@ -36,22 +36,19 @@ commaSep1 = T.commaSep1 hamlLexer
-- A Block always starts with some whitespace, then has a valid bit of data
hamlBlock = do whiteSpace
currentPos <- getPosition
- bs <- manyTill1
- (try pTag <|> pText <?> "tag or text")
- (shallower currentPos)
- return $ intercalate "+++\n" bs
+ bs <- (try pTag) <|> pText <?> "tag or text"
+ return bs
pTag = do currentPos <- getPosition
- try
- (do t <- lexeme tagParser <?> "tag"
- ts <- ((closeTag currentPos <|> eol) >> return []) <|>
- (try hamlBlock) <|>
- (blankLine) <?> "closing tag, block or blankLine in pTag"
- return $ intercalate "\n" $ filter (not . null) $
+ t <- lexeme tagParser <?> "tag"
+ nc <- optionMaybe $ closeTag currentPos
+ ts <- if (isJust nc)
+ then return []
+ else manyTill1 hamlBlock (shallowerOrEqual currentPos)
+ return $ intercalate "\n" $ filter (not . null) $
[ (indent currentPos) ++ "((" ++ (if (null ts) then "i" else "") ++ t ++ ")"
- , if null ts then [] else ts
+ , if (not $ null ts) then (indent currentPos ++ " (\n" ++ (intercalate "+++\n" ts ) ++ ")") else ""
, (indent currentPos) ++ " )"]
- )
pText = lexeme stringParser
closeTag p = isInline p >> char '/'
@@ -135,6 +132,14 @@ shallower p = (eof >> return []) <|>
False -> pzero
)
+shallowerOrEqual p =
+ (eof >> return []) <|>
+ (do innerPos <- getPosition
+ case (sourceColumn innerPos) <= (sourceColumn p) of
+ True -> return []
+ False -> pzero
+ )
+
deeper p = (eof >> return []) <|>
(do innerPos <- getPosition
case (sourceColumn innerPos) > (sourceColumn p) of
@@ -48,7 +48,7 @@ xhtmlBlock :: CharParser () String
xhtmlBlock = do whiteSpace
currentPos <- getPosition
bs <- (try pTag) <|> (try pPrintCode) <|> (try pCode) <|> pText
- return $ bs
+ return bs
pTag :: CharParser () String
pTag = do currentPos <- getPosition
@@ -58,7 +58,7 @@ pTag = do currentPos <- getPosition
else (manyTill1 xhtmlBlock (fromJust ctag))
return $ intercalate "\n" $ filter (not . null) $
[ (indent currentPos) ++ "((" ++ t ++ ")"
- , if (not $ null ts) then (indent currentPos ++ "(\n" ++ (intercalate "+++\n" ts ) ++ ")") else ""
+ , if (not $ null ts) then (indent currentPos ++ " (\n" ++ (intercalate "+++\n" ts ) ++ ")") else ""
, (indent currentPos) ++ " )"
]
<?> "tag for pTag"
@@ -93,7 +93,7 @@ retrieveAndRunController =
-- | This function dynamically loads (if needed) the 'View'
-- using the information provided by the 'Routes'. Views reside
--- in @App/Views@ and Layouts reside in @App/Layouts.
+-- in @App/Views@ and Layouts reside in @App/Layouts@.
-- The 'View' must contain a @markup@ function.
-- The first 'View' loaded is usually the Layout, which itself
-- loads the actual 'View'. If the @layout@ setting is empty, then

0 comments on commit 2219fb3

Please sign in to comment.