Skip to content
Browse files

Merge branch 'beta'

  • Loading branch information...
2 parents 8d77be1 + 811fbb8 commit fb45b4f1138aaf2718bfaa8cd6f5df29c4366d30 @snoyberg snoyberg committed Jul 9, 2012
Showing with 205 additions and 134 deletions.
  1. +6 −10 hamlet/Text/Hamlet.hs
  2. +77 −44 hamlet/Text/Hamlet/Parse.hs
  3. +1 −1 hamlet/Text/Hamlet/RT.hs
  4. +2 −12 hamlet/hamlet.cabal
  5. +2 −2 hamlet/test.hs
  6. +101 −46 hamlet/test/HamletTest.hs
  7. +6 −6 servius/servius.cabal
  8. +10 −13 servius/servius.hs
View
16 hamlet/Text/Hamlet.hs
@@ -28,6 +28,7 @@ module Text.Hamlet
, ToAttributes (..)
-- * Internal, for making more
, HamletSettings (..)
+ , NewlineStyle (..)
, hamletWithSettings
, hamletFileWithSettings
, defaultHamletSettings
@@ -46,12 +47,8 @@ import Data.Char (isUpper, isDigit)
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import qualified Data.Text.Lazy as TL
-#if MIN_VERSION_blaze_html(0,5,0)
import Text.Blaze.Html (Html, toHtml)
import Text.Blaze.Internal (preEscapedText)
-#else
-import Text.Blaze (Html, preEscapedText, toHtml)
-#endif
import qualified Data.Foldable as F
import Control.Monad (mplus)
import Data.Monoid (mempty, mappend)
@@ -218,11 +215,6 @@ htmlRules = do
hamlet :: QuasiQuoter
hamlet = hamletWithSettings hamletRules defaultHamletSettings
--- | A variant which adds newlines to the output. Useful for debugging
--- but may alter browser page layout.
-hamlet' :: QuasiQuoter
-hamlet' = hamletWithSettings hamletRules defaultHamletSettings{hamletNewlines=True}
-
xhamlet :: QuasiQuoter
xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings
@@ -286,7 +278,11 @@ hamletFromString qhr set s = do
hr <- qhr
case parseDoc set s of
Error s' -> error s'
- Ok d -> hrWithEnv hr $ \env -> docsToExp env hr [] d
+ Ok (mnl, d) -> do
+ case (mnl, hamletNewlines set) of
+ (Nothing, DefaultNewlineStyle) -> qReport False "Warning: default newline style has changed, using an explicit $newline is recommended"
+ _ -> return ()
+ hrWithEnv hr $ \env -> docsToExp env hr [] d
hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
hamletFileWithSettings qhr set fp = do
View
121 hamlet/Text/Hamlet/Parse.hs
@@ -8,9 +8,9 @@ module Text.Hamlet.Parse
, HamletSettings (..)
, defaultHamletSettings
, xhtmlHamletSettings
- , debugHamletSettings
, CloseStyle (..)
, Binding (..)
+ , NewlineStyle (..)
)
where
@@ -60,15 +60,38 @@ data Line = LineForall Deref Binding
, _lineContent :: [Content]
, _lineClasses :: [(Maybe Deref, [Content])]
, _lineAttrs :: [Deref]
+ , _lineNoNewline :: Bool
}
- | LineContent [Content]
+ | LineContent [Content] Bool -- ^ True == avoid newlines
deriving (Eq, Show, Read)
-parseLines :: HamletSettings -> String -> Result [(Int, Line)]
+parseLines :: HamletSettings -> String -> Result (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
parseLines set s =
- case parse (many $ parseLine set) s s of
+ case parse parser s s of
Left e -> Error $ show e
Right x -> Ok x
+ where
+ parser = do
+ mnewline <- parseNewline
+ let set' =
+ case mnewline of
+ Nothing ->
+ case hamletNewlines set of
+ DefaultNewlineStyle -> set { hamletNewlines = AlwaysNewlines }
+ _ -> set
+ Just n -> set { hamletNewlines = n }
+ res <- many (parseLine set')
+ return (mnewline, set', res)
+
+ parseNewline =
+ (try (many eol' >> string "$newline ") >> parseNewline' >>= \nl -> eol' >> return nl) <|>
+ return Nothing
+ parseNewline' =
+ (try (string "always") >> return (Just AlwaysNewlines)) <|>
+ (try (string "never") >> return (Just NoNewlines)) <|>
+ (try (string "text") >> return (Just NewlinesText))
+
+ eol' = (char '\n' >> return ()) <|> (string "\r\n" >> return ())
parseLine :: HamletSettings -> Parser (Int, Line)
parseLine set = do
@@ -91,34 +114,34 @@ parseLine set = do
controlOf <|>
angle <|>
invalidDollar <|>
- (eol' >> return (LineContent [])) <|>
+ (eol' >> return (LineContent [] True)) <|>
(do
- cs <- content InContent
+ (cs, avoidNewLines) <- content InContent
isEof <- (eof >> return True) <|> return False
if null cs && ss == 0 && isEof
then fail "End of Hamlet template"
- else return $ LineContent cs)
+ else return $ LineContent cs avoidNewLines)
return (ss, x)
where
eol' = (char '\n' >> return ()) <|> (string "\r\n" >> return ())
eol = eof <|> eol'
spaceTabs = many $ oneOf " \t"
doctype = do
try $ string "!!!" >> eol
- return $ LineContent [ContentRaw $ hamletDoctype set ++ "\n"]
+ return $ LineContent [ContentRaw $ hamletDoctype set ++ "\n"] True
doctypeDollar = do
_ <- try $ string "$doctype "
name <- many $ noneOf "\r\n"
eol
- case lookup name doctypeNames of
+ case lookup name $ hamletDoctypeNames set of
Nothing -> fail $ "Unknown doctype name: " ++ name
- Just val -> return $ LineContent [ContentRaw $ val ++ "\n"]
+ Just val -> return $ LineContent [ContentRaw $ val ++ "\n"] True
doctypeRaw = do
x <- try $ string "<!"
y <- many $ noneOf "\r\n"
eol
- return $ LineContent [ContentRaw $ concat [x, y, "\n"]]
+ return $ LineContent [ContentRaw $ concat [x, y, "\n"]] True
invalidDollar = do
_ <- char '$'
@@ -127,13 +150,13 @@ parseLine set = do
_ <- try $ string "$#"
_ <- many $ noneOf "\r\n"
eol
- return $ LineContent []
+ return $ LineContent [] True
htmlComment = do
_ <- try $ string "<!--"
_ <- manyTill anyChar $ try $ string "-->"
x <- many nonComments
eol
- return $ LineContent [ContentRaw $ concat x] -- FIXME handle variables?
+ return $ LineContent [ContentRaw $ concat x] False {- FIXME -} -- FIXME handle variables?
nonComments = (many1 $ noneOf "\r\n<") <|> (do
_ <- char '<'
(do
@@ -142,8 +165,8 @@ parseLine set = do
return "") <|> return "<")
backslash = do
_ <- char '\\'
- (eol >> return (LineContent [ContentRaw "\n"]))
- <|> (LineContent <$> content InContent)
+ (eol >> return (LineContent [ContentRaw "\n"] True))
+ <|> (uncurry LineContent <$> content InContent)
controlIf = do
_ <- try $ string "$if"
spaces
@@ -204,41 +227,42 @@ parseLine set = do
NotInQuotes -> return ()
NotInQuotesAttr -> return ()
InContent -> eol
- return $ cc x
+ return (cc $ map fst x, or $ map snd x)
where
cc [] = []
cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c
cc (a:b) = a : cc b
content' cr = contentHash <|> contentAt <|> contentCaret
<|> contentUnder
- <|> contentReg cr
+ <|> contentReg' cr
contentHash = do
x <- parseHash
case x of
- Left str -> return $ ContentRaw str
- Right deref -> return $ ContentVar deref
+ Left str -> return (ContentRaw str, null str)
+ Right deref -> return (ContentVar deref, False)
contentAt = do
x <- parseAt
return $ case x of
- Left str -> ContentRaw str
- Right (s, y) -> ContentUrl y s
+ Left str -> (ContentRaw str, null str)
+ Right (s, y) -> (ContentUrl y s, False)
contentCaret = do
x <- parseCaret
case x of
- Left str -> return $ ContentRaw str
- Right deref -> return $ ContentEmbed deref
+ Left str -> return (ContentRaw str, null str)
+ Right deref -> return (ContentEmbed deref, False)
contentUnder = do
x <- parseUnder
case x of
- Left str -> return $ ContentRaw str
- Right deref -> return $ ContentMsg deref
+ Left str -> return (ContentRaw str, null str)
+ Right deref -> return (ContentMsg deref, False)
+ contentReg' x = (flip (,) False) <$> contentReg x
contentReg InContent = (ContentRaw . return) <$> noneOf "#@^\r\n"
contentReg NotInQuotes = (ContentRaw . return) <$> noneOf "@^#. \t\n\r>"
contentReg NotInQuotesAttr = (ContentRaw . return) <$> noneOf "@^ \t\n\r>"
contentReg InQuotes = (ContentRaw . return) <$> noneOf "#@^\\\"\n\r"
tagAttribValue notInQuotes = do
cr <- (char '"' >> return InQuotes) <|> return notInQuotes
- content cr
+ fst <$> content cr
tagIdent = char '#' >> TagIdent <$> tagAttribValue NotInQuotes
tagCond = do
d <- between (char ':') (char ':') parseDeref
@@ -284,11 +308,11 @@ parseLine set = do
(tagIdent <|> tagCond <|> tagClass Nothing <|> tagAttrs <|> tagAttrib Nothing))
_ <- many $ oneOf " \t\r\n"
_ <- char '>'
- c <- content InContent
+ (c, avoidNewLines) <- content InContent
let (tn, attr, classes, attrsd) = tag' $ TagName name : xs
if '/' `elem` tn
then fail "A tag name may not contain a slash. Perhaps you have a closing tag in your HTML."
- else return $ LineTag tn attr c classes attrsd
+ else return $ LineTag tn attr c classes attrsd avoidNewLines
data TagPiece = TagName String
| TagIdent [Content]
@@ -348,7 +372,7 @@ nestToDoc set (Nest (LineCase d) inside:rest) = do
cases <- mapM getOf inside
rest' <- nestToDoc set rest
Ok $ DocCase d cases : rest'
-nestToDoc set (Nest (LineTag tn attrs content classes attrsD) inside:rest) = do
+nestToDoc set (Nest (LineTag tn attrs content classes attrsD avoidNewLine) inside:rest) = do
let attrFix (x, y, z) = (x, y, [(Nothing, z)])
let takeClass (a, "class", b) = Just (a, fromMaybe [] b)
takeClass _ = Nothing
@@ -374,24 +398,28 @@ nestToDoc set (Nest (LineTag tn attrs content classes attrsD) inside:rest) = do
start = DocContent $ ContentRaw $ "<" ++ tn
attrs'' = concatMap attrToContent attrs'
newline' = DocContent $ ContentRaw
- $ if hamletNewlines set then "\n" else ""
+ $ case hamletNewlines set of { AlwaysNewlines | not avoidNewLine -> "\n"; _ -> "" }
inside' <- nestToDoc set inside
rest' <- nestToDoc set rest
Ok $ start
: attrs''
++ map (DocContent . ContentAttrs) attrsD
++ seal
- : newline'
: map DocContent content
++ inside'
++ end
: newline'
: rest'
-nestToDoc set (Nest (LineContent content) inside:rest) = do
+nestToDoc set (Nest (LineContent content avoidNewLine) inside:rest) = do
inside' <- nestToDoc set inside
rest' <- nestToDoc set rest
let newline' = DocContent $ ContentRaw
- $ if hamletNewlines set then "\n" else ""
+ $ case hamletNewlines set of { NoNewlines -> ""; _ -> if nextIsContent && not avoidNewLine then "\n" else "" }
+ nextIsContent =
+ case (inside, rest) of
+ ([], Nest LineContent{} _:_) -> True
+ ([], Nest LineTag{} _:_) -> True
+ _ -> False
Ok $ map DocContent content ++ newline':inside' ++ rest'
nestToDoc _set (Nest (LineElseIf _) _:_) = Error "Unexpected elseif"
nestToDoc _set (Nest LineElse _:_) = Error "Unexpected else"
@@ -421,14 +449,14 @@ compressDoc ( DocContent (ContentRaw x)
) = compressDoc $ (DocContent $ ContentRaw $ x ++ y) : rest
compressDoc (DocContent x:rest) = DocContent x : compressDoc rest
-parseDoc :: HamletSettings -> String -> Result [Doc]
+parseDoc :: HamletSettings -> String -> Result (Maybe NewlineStyle, [Doc])
parseDoc set s = do
- ls <- parseLines set s
- let notEmpty (_, LineContent []) = False
+ (mnl, set', ls) <- parseLines set s
+ let notEmpty (_, LineContent [] _) = False
notEmpty _ = True
let ns = nestLines $ filter notEmpty ls
- ds <- nestToDoc set ns
- return $ compressDoc ds
+ ds <- nestToDoc set' ns
+ return (mnl, compressDoc ds)
attrToContent :: (Maybe Deref, String, [(Maybe Deref, Maybe [Content])]) -> [Doc]
attrToContent (Just cond, k, v) =
@@ -466,12 +494,20 @@ data HamletSettings = HamletSettings
hamletDoctype :: String
-- | Should we add newlines to the output, making it more human-readable?
-- Useful for client-side debugging but may alter browser page layout.
- , hamletNewlines :: Bool
+ , hamletNewlines :: NewlineStyle
-- | How a tag should be closed. Use this to switch between HTML, XHTML
-- or even XML output.
, hamletCloseStyle :: String -> CloseStyle
+ -- | Mapping from short names in \"$doctype\" statements to full doctype.
+ , hamletDoctypeNames :: [(String, String)]
}
+data NewlineStyle = NoNewlines -- ^ never add newlines
+ | NewlinesText -- ^ add newlines between consecutive text lines
+ | AlwaysNewlines -- ^ add newlines everywhere
+ | DefaultNewlineStyle
+ deriving Show
+
htmlEmptyTags :: Set String
htmlEmptyTags = Set.fromAscList
[ "area"
@@ -491,19 +527,16 @@ htmlEmptyTags = Set.fromAscList
-- | Defaults settings: HTML5 doctype and HTML-style empty tags.
defaultHamletSettings :: HamletSettings
-defaultHamletSettings = HamletSettings "<!DOCTYPE html>" False htmlCloseStyle
+defaultHamletSettings = HamletSettings "<!DOCTYPE html>" DefaultNewlineStyle htmlCloseStyle doctypeNames
xhtmlHamletSettings :: HamletSettings
xhtmlHamletSettings =
- HamletSettings doctype False xhtmlCloseStyle
+ HamletSettings doctype DefaultNewlineStyle xhtmlCloseStyle doctypeNames
where
doctype =
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" " ++
"\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
-debugHamletSettings :: HamletSettings
-debugHamletSettings = HamletSettings "<!DOCTYPE html>" True htmlCloseStyle
-
htmlCloseStyle :: String -> CloseStyle
htmlCloseStyle s =
if Set.member s htmlEmptyTags
View
2 hamlet/Text/Hamlet/RT.hs
@@ -64,7 +64,7 @@ parseHamletRT :: Failure HamletException m
parseHamletRT set s =
case parseDoc set s of
Error s' -> failure $ HamletParseException s'
- Ok x -> liftM HamletRT $ mapM convert x
+ Ok (_, x) -> liftM HamletRT $ mapM convert x
where
convert x@(DocForall deref (BindVar (Ident ident)) docs) = do
deref' <- flattenDeref' x deref
View
14 hamlet/hamlet.cabal
@@ -1,5 +1,5 @@
name: hamlet
-version: 1.0.1.4
+version: 1.1.0
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@@ -39,10 +39,6 @@ extra-source-files:
test/tmp.hs
test.hs
-flag blaze_html_0_5
- description: Use blaze-html 0.5 and blaze-markup 0.5
- default: True
-
library
build-depends: base >= 4 && < 5
, shakespeare >= 1.0 && < 1.1
@@ -54,14 +50,8 @@ library
, containers >= 0.2
, blaze-builder >= 0.2 && < 0.4
, process >= 1.0 && < 1.2
-
- if flag(blaze_html_0_5)
- build-depends:
- blaze-html >= 0.5 && < 0.6
+ , blaze-html >= 0.5 && < 0.6
, blaze-markup >= 0.5.1 && < 0.6
- else
- build-depends:
- blaze-html >= 0.4 && < 0.5
exposed-modules: Text.Hamlet
Text.Hamlet.RT
View
4 hamlet/test.hs
@@ -1,5 +1,5 @@
import HamletTest (specs)
-import Test.Hspec
+import Test.Hspec.Core
main :: IO ()
-main = hspecX [specs]
+main = hspec [specs]
View
147 hamlet/test/HamletTest.hs
@@ -85,7 +85,7 @@ $#a third one|]
, it "ignores a blank line" $ do
- helper "<p>foo</p>" [hamlet|
+ helper "<p>foo</p>\n" [hamlet|
<p>
foo
@@ -96,9 +96,10 @@ $#a third one|]
- , it "hamlet angle bracket syntax" $
+ , it "angle bracket syntax" $
helper "<p class=\"foo\" height=\"100\"><span id=\"bar\" width=\"50\">HELLO</span></p>"
[hamlet|
+$newline never
<p.foo height="100">
<span #bar width=50>HELLO
|]
@@ -108,7 +109,9 @@ $#a third one|]
, it "hamlet module names" $
let foo = "foo" in
helper "oof oof 3.14 -5"
- [hamlet|#{Data.List.reverse foo} #
+ [hamlet|
+$newline never
+#{Data.List.reverse foo} #
#{L.reverse foo} #
#{show 3.14} #{show -5}|]
@@ -159,6 +162,7 @@ $#a third one|]
, it "HTML comments" $ do
helper "<p>1</p><p>2 not ignored</p>" [hamlet|
+$newline never
<p>1
<!-- ignored comment -->
<p>
@@ -194,13 +198,13 @@ $nothing
, it "conditional class" $ do
- helper "<p class=\"current\"></p>"
+ helper "<p class=\"current\"></p>\n"
[hamlet|<p :False:.ignored :True:.current>|]
- helper "<p class=\"1 3 2 4\"></p>"
+ helper "<p class=\"1 3 2 4\"></p>\n"
[hamlet|<p :True:.1 :True:class=2 :False:.a :False:class=b .3 class=4>|]
- helper "<p class=\"foo bar baz\"></p>"
+ helper "<p class=\"foo bar baz\"></p>\n"
[hamlet|<p class=foo class=bar class=baz>|]
@@ -216,31 +220,32 @@ $forall x <- set
, it "non-poly HTML" $ do
- helperHtml "<h1>HELLO WORLD</h1>" [shamlet|
+ helperHtml "<h1>HELLO WORLD</h1>\n" [shamlet|
<h1>HELLO WORLD
|]
- helperHtml "<h1>HELLO WORLD</h1>" $(shamletFile "test/hamlets/nonpolyhtml.hamlet")
+ helperHtml "<h1>HELLO WORLD</h1>\n" $(shamletFile "test/hamlets/nonpolyhtml.hamlet")
, it "non-poly Hamlet" $ do
let embed = [hamlet|<p>EMBEDDED|]
- helper "<h1>url</h1><p>EMBEDDED</p>" [hamlet|
+ helper "<h1>url</h1>\n<p>EMBEDDED</p>\n" [hamlet|
<h1>@{Home}
^{embed}
|]
- helper "<h1>url</h1>" $(hamletFile "test/hamlets/nonpolyhamlet.hamlet")
+ helper "<h1>url</h1>\n" $(hamletFile "test/hamlets/nonpolyhamlet.hamlet")
, it "non-poly IHamlet" $ do
let embed = [ihamlet|<p>EMBEDDED|]
- ihelper "<h1>Adios</h1><p>EMBEDDED</p>" [ihamlet|
+ ihelper "<h1>Adios</h1>\n<p>EMBEDDED</p>\n" [ihamlet|
<h1>_{Goodbye}
^{embed}
|]
- ihelper "<h1>Hola</h1>" $(ihamletFile "test/hamlets/nonpolyihamlet.hamlet")
+ ihelper "<h1>Hola</h1>\n" $(ihamletFile "test/hamlets/nonpolyihamlet.hamlet")
, it "pattern-match tuples: forall" $ do
let people = [("Michael", 26), ("Miriam", 25)]
helper "<dl><dt>Michael</dt><dd>26</dd><dt>Miriam</dt><dd>25</dd></dl>" [hamlet|
+$newline never
<dl>
$forall (name, age) <- people
<dt>#{name}
@@ -249,6 +254,7 @@ $forall x <- set
, it "pattern-match tuples: maybe" $ do
let people = Just ("Michael", 26)
helper "<dl><dt>Michael</dt><dd>26</dd></dl>" [hamlet|
+$newline never
<dl>
$maybe (name, age) <- people
<dt>#{name}
@@ -257,13 +263,15 @@ $forall x <- set
, it "pattern-match tuples: with" $ do
let people = ("Michael", 26)
helper "<dl><dt>Michael</dt><dd>26</dd></dl>" [hamlet|
+$newline never
<dl>
$with (name, age) <- people
<dt>#{name}
<dd>#{show age}
|]
, it "list syntax for interpolation" $ do
helper "<ul><li>1</li><li>2</li><li>3</li></ul>" [hamlet|
+$newline never
<ul>
$forall num <- [1, 2, 3]
<li>#{show num}
@@ -275,6 +283,7 @@ $forall x <- set
helper "5" [hamlet|#{show (2 + 3)}|]
-}
, it "doctypes" $ helper "<!DOCTYPE html>\n<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n" [hamlet|
+$newline never
$doctype 5
$doctype strict
|]
@@ -283,6 +292,7 @@ $doctype strict
let nothing = Nothing
justTrue = Just True
in helper "<br><br><br><br>" [hamlet|
+$newline never
$case nothing
$of Just val
$of Nothing
@@ -306,7 +316,8 @@ $case Nothing
, it "case on Url" $
let url1 = Home
url2 = Sub SubUrl
- in helper "<br><br>" [hamlet|
+ in helper "<br>\n<br>\n" [hamlet|
+$newline always
$case url1
$of Home
<br>
@@ -322,6 +333,7 @@ $case url2
, it "pattern-match constructors: forall" $ do
let people = [Pair "Michael" 26, Pair "Miriam" 25]
helper "<dl><dt>Michael</dt><dd>26</dd><dt>Miriam</dt><dd>25</dd></dl>" [hamlet|
+$newline text
<dl>
$forall Pair name age <- people
<dt>#{name}
@@ -330,6 +342,7 @@ $case url2
, it "pattern-match constructors: maybe" $ do
let people = Just $ Pair "Michael" 26
helper "<dl><dt>Michael</dt><dd>26</dd></dl>" [hamlet|
+$newline text
<dl>
$maybe Pair name age <- people
<dt>#{name}
@@ -338,31 +351,64 @@ $case url2
, it "pattern-match constructors: with" $ do
let people = Pair "Michael" 26
helper "<dl><dt>Michael</dt><dd>26</dd></dl>" [hamlet|
+$newline text
<dl>
$with Pair name age <- people
<dt>#{name}
<dd>#{show age}
|]
, it "multiline tags" $ helper
- "<foo bar=\"baz\" bin=\"bin\">content</foo>" [hamlet|
+ "<foo bar=\"baz\" bin=\"bin\">content</foo>\n" [hamlet|
<foo bar=baz
bin=bin>content
|]
, let attrs = [("bar", "baz"), ("bin", "<>\"&")]
in it "*{...} attributes" $ helper
- "<foo bar=\"baz\" bin=\"&lt;&gt;&quot;&amp;\">content</foo>" [hamlet|
+ "<foo bar=\"baz\" bin=\"&lt;&gt;&quot;&amp;\">content</foo>\n" [hamlet|
<foo *{attrs}>content
|]
, it "blank attr values" $ helper
- "<foo bar=\"\" baz bin=\"\"></foo>"
+ "<foo bar=\"\" baz bin=\"\"></foo>\n"
[hamlet|<foo bar="" baz bin=>|]
, it "greater than in attr" $ helper
- "<button data-bind=\"enable: someFunction() > 5\">hello</button>"
+ "<button data-bind=\"enable: someFunction() > 5\">hello</button>\n"
[hamlet|<button data-bind="enable: someFunction() > 5">hello|]
, it "normal doctype" $ helper
"<!DOCTYPE html>\n"
[hamlet|<!DOCTYPE html>|]
+ , it "newline style" $ helper
+ "<p>foo</p>\n<pre>bar\nbaz\nbin</pre>\n"
+ [hamlet|
+$newline always
+<p>foo
+<pre>
+ bar
+ baz
+ bin
+|]
+ , it "avoid newlines" $ helper
+ "<p>foo</p><pre>barbazbin</pre>"
+ [hamlet|
+$newline always
+<p>foo#
+<pre>#
+ bar#
+ baz#
+ bin#
+|]
+ , it "manual linebreaks" $ helper
+ "<p>foo</p><pre>bar\nbaz\nbin</pre>"
+ [hamlet|
+$newline never
+<p>foo
+<pre>
+ bar
+ \
+ baz
+ \
+ bin
+|]
]
data Pair = Pair String Int
@@ -450,10 +496,12 @@ caseStatic = helper "some static content" [hamlet|some static content|]
caseTag :: Assertion
caseTag = do
helper "<p class=\"foo\"><div id=\"bar\">baz</div></p>" [hamlet|
+$newline text
<p .foo>
<#bar>baz
|]
helper "<p class=\"foo.bar\"><div id=\"bar\">baz</div></p>" [hamlet|
+$newline text
<p class=foo.bar>
<#bar>baz
|]
@@ -585,24 +633,24 @@ $with n <- " , something", y <- n
|]
caseScriptNotEmpty :: Assertion
-caseScriptNotEmpty = helper "<script></script>" [hamlet|<script>|]
+caseScriptNotEmpty = helper "<script></script>\n" [hamlet|<script>|]
caseMetaEmpty :: Assertion
caseMetaEmpty = do
- helper "<meta>" [hamlet|<meta>|]
- helper "<meta/>" [xhamlet|<meta>|]
+ helper "<meta>\n" [hamlet|<meta>|]
+ helper "<meta/>\n" [xhamlet|<meta>|]
caseInputEmpty :: Assertion
caseInputEmpty = do
- helper "<input>" [hamlet|<input>|]
- helper "<input/>" [xhamlet|<input>|]
+ helper "<input>\n" [hamlet|<input>|]
+ helper "<input/>\n" [xhamlet|<input>|]
caseMultiClass :: Assertion
-caseMultiClass = helper "<div class=\"foo bar\"></div>" [hamlet|<.foo.bar>|]
+caseMultiClass = helper "<div class=\"foo bar\"></div>\n" [hamlet|<.foo.bar>|]
caseAttribOrder :: Assertion
caseAttribOrder =
- helper "<meta 1 2 3>" [hamlet|<meta 1 2 3>|]
+ helper "<meta 1 2 3>\n" [hamlet|<meta 1 2 3>|]
caseNothing :: Assertion
caseNothing = do
@@ -649,6 +697,7 @@ caseUrlParams = do
caseEscape :: Assertion
caseEscape = do
helper "#this is raw\n " [hamlet|
+$newline never
\#this is raw
\
\
@@ -664,16 +713,16 @@ caseEmptyStatementList = do
caseAttribCond :: Assertion
caseAttribCond = do
- helper "<select></select>" [hamlet|<select :False:selected>|]
- helper "<select selected></select>" [hamlet|<select :True:selected>|]
- helper "<meta var=\"foo:bar\">" [hamlet|<meta var=foo:bar>|]
- helper "<select selected></select>"
+ helper "<select></select>\n" [hamlet|<select :False:selected>|]
+ helper "<select selected></select>\n" [hamlet|<select :True:selected>|]
+ helper "<meta var=\"foo:bar\">\n" [hamlet|<meta var=foo:bar>|]
+ helper "<select selected></select>\n"
[hamlet|<select :true theArg:selected>|]
- helper "<select></select>" [hamlet|<select :False:selected>|]
- helper "<select selected></select>" [hamlet|<select :True:selected>|]
- helper "<meta var=\"foo:bar\">" [hamlet|<meta var=foo:bar>|]
- helper "<select selected></select>"
+ helper "<select></select>\n" [hamlet|<select :False:selected>|]
+ helper "<select selected></select>\n" [hamlet|<select :True:selected>|]
+ helper "<meta var=\"foo:bar\">\n" [hamlet|<meta var=foo:bar>|]
+ helper "<select selected></select>\n"
[hamlet|<select :true theArg:selected>|]
caseNonAscii :: Assertion
@@ -689,37 +738,41 @@ $maybe x <- Just urlParams
caseTrailingDollarSign :: Assertion
caseTrailingDollarSign =
- helper "trailing space \ndollar sign #" [hamlet|trailing space #
+ helper "trailing space \ndollar sign #" [hamlet|
+$newline never
+trailing space #
\
dollar sign #\
|]
caseNonLeadingPercent :: Assertion
caseNonLeadingPercent =
helper "<span style=\"height:100%\">foo</span>" [hamlet|
+$newline never
<span style=height:100%>foo
|]
caseQuotedAttribs :: Assertion
caseQuotedAttribs =
helper "<input type=\"submit\" value=\"Submit response\">" [hamlet|
+$newline never
<input type=submit value="Submit response">
|]
caseSpacedDerefs :: Assertion
caseSpacedDerefs = do
helper "&lt;var&gt;" [hamlet|#{var theArg}|]
- helper "<div class=\"&lt;var&gt;\"></div>" [hamlet|<.#{var theArg}>|]
+ helper "<div class=\"&lt;var&gt;\"></div>\n" [hamlet|<.#{var theArg}>|]
caseAttribVars :: Assertion
caseAttribVars = do
- helper "<div id=\"&lt;var&gt;\"></div>" [hamlet|<##{var theArg}>|]
- helper "<div class=\"&lt;var&gt;\"></div>" [hamlet|<.#{var theArg}>|]
- helper "<div f=\"&lt;var&gt;\"></div>" [hamlet|< f=#{var theArg}>|]
+ helper "<div id=\"&lt;var&gt;\"></div>\n" [hamlet|<##{var theArg}>|]
+ helper "<div class=\"&lt;var&gt;\"></div>\n" [hamlet|<.#{var theArg}>|]
+ helper "<div f=\"&lt;var&gt;\"></div>\n" [hamlet|< f=#{var theArg}>|]
- helper "<div id=\"&lt;var&gt;\"></div>" [hamlet|<##{var theArg}>|]
- helper "<div class=\"&lt;var&gt;\"></div>" [hamlet|<.#{var theArg}>|]
- helper "<div f=\"&lt;var&gt;\"></div>" [hamlet|< f=#{var theArg}>|]
+ helper "<div id=\"&lt;var&gt;\"></div>\n" [hamlet|<##{var theArg}>|]
+ helper "<div class=\"&lt;var&gt;\"></div>\n" [hamlet|<.#{var theArg}>|]
+ helper "<div f=\"&lt;var&gt;\"></div>\n" [hamlet|< f=#{var theArg}>|]
caseStringsAndHtml :: Assertion
caseStringsAndHtml = do
@@ -732,6 +785,7 @@ caseNesting = do
helper
"<table><tbody><tr><td>1</td></tr><tr><td>2</td></tr></tbody></table>"
[hamlet|
+$newline never
<table>
<tbody>
$forall user <- users
@@ -746,6 +800,7 @@ caseNesting = do
, "</select>"
])
[hamlet|
+$newline never
<select #"#{name}" name=#{name}>
<option :isBoolBlank val:selected>
<option value=true :isBoolTrue val:selected>Yes
@@ -771,8 +826,8 @@ caseCurrency =
caseExternal :: Assertion
caseExternal = do
- helper "foo<br>" $(hamletFile "test/hamlets/external.hamlet")
- helper "foo<br/>" $(xhamletFile "test/hamlets/external.hamlet")
+ helper "foo\n<br>\n" $(hamletFile "test/hamlets/external.hamlet")
+ helper "foo\n<br/>\n" $(xhamletFile "test/hamlets/external.hamlet")
where
foo = "foo"
@@ -803,14 +858,14 @@ caseHamlet' :: Assertion
caseHamlet' = do
helper' "foo" [shamlet|foo|]
helper' "foo" [xshamlet|foo|]
- helper "<br>" $ const $ [shamlet|<br>|]
- helper "<br/>" $ const $ [xshamlet|<br>|]
+ helper "<br>\n" $ const $ [shamlet|<br>|]
+ helper "<br/>\n" $ const $ [xshamlet|<br>|]
-- new with generalized stuff
helper' "foo" [shamlet|foo|]
helper' "foo" [xshamlet|foo|]
- helper "<br>" $ const $ [shamlet|<br>|]
- helper "<br/>" $ const $ [xshamlet|<br>|]
+ helper "<br>\n" $ const $ [shamlet|<br>|]
+ helper "<br/>\n" $ const $ [xshamlet|<br>|]
instance Show Url where
View
12 servius/servius.cabal
@@ -1,5 +1,5 @@
Name: servius
-Version: 1.0.0.2
+Version: 1.1.0
Synopsis: Serve Shakespearean templates via Warp
Homepage: http://github.com/yesodweb/hamlet
License: MIT
@@ -15,9 +15,9 @@ Description: Does not support any variable interpolation. Supports Hamle
Executable servius
Main-is: servius.hs
Build-depends: base >= 4 && < 5
- , warp >= 1.2 && < 1.3
- , wai-app-static >= 1.2 && < 1.3
- , wai-extra >= 1.2 && < 1.3
+ , warp >= 1.3 && < 1.4
+ , wai-app-static >= 1.3 && < 1.4
+ , wai-extra >= 1.3 && < 1.4
, cmdargs >= 0.6.7
, directory >= 1.0
, containers >= 0.2
@@ -26,10 +26,10 @@ Executable servius
, blaze-builder
, blaze-html >= 0.5 && < 0.6
, http-types
- , hamlet >= 1.0 && < 1.1
+ , hamlet >= 1.1 && < 1.2
, shakespeare-css >= 1.0 && < 1.1
, transformers
- , wai >= 1.2 && < 1.3
+ , wai >= 1.3 && < 1.4
source-repository head
type: git
View
23 servius/servius.hs
@@ -1,11 +1,6 @@
{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
-import Network.Wai.Application.Static
- ( StaticSettings (..), staticApp, defaultMimeType, defaultListing
- , defaultMimeTypes, mimeTypeByExt
- , defaultFileServerSettings, fileSystemLookup
- , fileName, toFilePath
- )
+import Network.Wai.Application.Static (staticApp, defaultFileServerSettings)
import Network.Wai.Handler.Warp (run)
import System.Console.CmdArgs hiding (def)
import Text.Printf (printf)
@@ -30,6 +25,10 @@ import Network.HTTP.Types (status200)
import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
import qualified Data.Text.Lazy as TL
import Blaze.ByteString.Builder.Char.Utf8 (fromLazyText)
+import WaiAppStatic.Mime (defaultMimeMap, mimeByExt, defaultMimeType)
+import WaiAppStatic.Types (ssIndices, toPiece, ssGetMimeType, fileName)
+import Data.String (fromString)
+import Data.Maybe (mapMaybe)
data Args = Args
{ docroot :: FilePath
@@ -48,19 +47,17 @@ defaultArgs = Args "." ["index.html", "index.htm"] 3000 False False False []
main :: IO ()
main = do
Args {..} <- cmdArgs defaultArgs
- let mime' = map (toFilePath *** S8.pack) mime
- let mimeMap = Map.fromList mime' `Map.union` defaultMimeTypes
+ let mime' = map (pack *** S8.pack) mime
+ let mimeMap = Map.fromList mime' `Map.union` defaultMimeMap
docroot' <- canonicalizePath docroot
unless quiet $ printf "Serving directory %s on port %d with %s index files.\n" docroot' port (if noindex then "no" else show index)
let middle = gzip def
. (if verbose then logStdoutDev else id)
. autohead
. shake docroot
- run port $ middle $ staticApp defaultFileServerSettings
- { ssFolder = fileSystemLookup $ toFilePath docroot
- , ssIndices = if noindex then [] else map pack index
- , ssListing = Just defaultListing
- , ssGetMimeType = return . mimeTypeByExt mimeMap defaultMimeType . fileName
+ run port $ middle $ staticApp (defaultFileServerSettings $ fromString docroot)
+ { ssIndices = if noindex then [] else mapMaybe (toPiece . pack) index
+ , ssGetMimeType = return . mimeByExt mimeMap defaultMimeType . fileName
}
shake :: FilePath -> Middleware

0 comments on commit fb45b4f

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