packages feed

hamlet 0.10.9.1 → 1.0.0

raw patch · 6 files changed

+125/−70 lines, 6 filesdep ~containersdep ~hamletdep ~shakespearePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers, hamlet, shakespeare

API changes (from Hackage documentation)

+ Text.Hamlet: class ToAttributes a
+ Text.Hamlet: instance ToAttributes (String, String)
+ Text.Hamlet: instance ToAttributes (Text, Text)
+ Text.Hamlet: instance ToAttributes [(String, String)]
+ Text.Hamlet: instance ToAttributes [(Text, Text)]
+ Text.Hamlet: toAttributes :: ToAttributes a => a -> [(Text, Text)]

Files

Text/Hamlet.hs view
@@ -24,6 +24,8 @@     , HtmlUrlI18n     , ihamlet     , ihamletFile+      -- * Type classes+    , ToAttributes (..)       -- * Internal, for making more     , HamletSettings     , hamletWithSettings@@ -45,7 +47,33 @@ import Text.Blaze (Html, preEscapedText, toHtml) import qualified Data.Foldable as F import Control.Monad (mplus)+import Data.Monoid (mempty, mappend)+import Control.Arrow ((***)) +-- | Convert some value to a list of attribute pairs.+class ToAttributes a where+    toAttributes :: a -> [(Text, Text)]+instance ToAttributes (Text, Text) where+    toAttributes = return+instance ToAttributes (String, String) where+    toAttributes (k, v) = [(pack k, pack v)]+instance ToAttributes [(Text, Text)] where+    toAttributes = id+instance ToAttributes [(String, String)] where+    toAttributes = map (pack *** pack)++attrsToHtml :: [(Text, Text)] -> Html+attrsToHtml =+    foldr go mempty+  where+    go (k, v) rest =+        toHtml " "+        `mappend` preEscapedText k+        `mappend` preEscapedText (pack "=\"")+        `mappend` toHtml v+        `mappend` preEscapedText (pack "\"")+        `mappend` rest+ type Render url = url -> [(Text, Text)] -> Text type Translate msg = msg -> Html @@ -165,6 +193,9 @@         Nothing -> error "Message interpolation used, but no message renderer provided"         Just wrender -> wrender $ \render ->             return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d)+contentToExp _ hr scope (ContentAttrs d) = do+    html <- [|attrsToHtml . toAttributes|]+    return $ hrFromHtml hr `AppE` (html `AppE` derefToExp scope d)  shamlet :: QuasiQuoter shamlet = hamletWithSettings htmlRules defaultHamletSettings
Text/Hamlet/Parse.hs view
@@ -22,7 +22,7 @@ import Text.ParserCombinators.Parsec hiding (Line) import Data.Set (Set) import qualified Data.Set as Set-import Data.Maybe (mapMaybe)+import Data.Maybe (mapMaybe, fromMaybe)  data Result v = Error String | Ok v     deriving (Show, Eq, Read, Data, Typeable)@@ -42,6 +42,7 @@              | ContentUrl Bool Deref -- ^ bool: does it include params?              | ContentEmbed Deref              | ContentMsg Deref+             | ContentAttrs Deref     deriving (Show, Eq, Read, Data, Typeable)  data Line = LineForall Deref Binding@@ -55,9 +56,10 @@           | LineOf [Ident]           | LineTag             { _lineTagName :: String-            , _lineAttr :: [(Maybe Deref, String, [Content])]+            , _lineAttr :: [(Maybe Deref, String, Maybe [Content])]             , _lineContent :: [Content]             , _lineClasses :: [(Maybe Deref, [Content])]+            , _lineAttrs :: [Deref]             }           | LineContent [Content]     deriving (Eq, Show, Read)@@ -236,15 +238,22 @@         tagClass (Just d) <|> tagAttrib (Just d)     tagClass x = char '.' >> (TagClass . (,) x) <$> tagAttribValue NotInQuotes     tagAttrib cond = do-        s <- many1 $ noneOf " \t=\r\n>"-        v <- (char '=' >> tagAttribValue NotInQuotesAttr) <|> return []+        s <- many1 $ noneOf " \t=\r\n><"+        v <- (char '=' >> Just <$> tagAttribValue NotInQuotesAttr) <|> return Nothing         return $ TagAttrib (cond, s, v)-    tag' = foldr tag'' ("div", [], [])-    tag'' (TagName s) (_, y, z) = (s, y, z)-    tag'' (TagIdent s) (x, y, z) = (x, (Nothing, "id", s) : y, z)-    tag'' (TagClass s) (x, y, z) = (x, y, s : z)-    tag'' (TagAttrib s) (x, y, z) = (x, s : y, z) +    tagAttrs = do+        _ <- char '*'+        d <- between (char '{') (char '}') parseDeref+        return $ TagAttribs d++    tag' = foldr tag'' ("div", [], [], [])+    tag'' (TagName s) (_, y, z, as) = (s, y, z, as)+    tag'' (TagIdent s) (x, y, z, as) = (x, (Nothing, "id", Just s) : y, z, as)+    tag'' (TagClass s) (x, y, z, as) = (x, y, s : z, as)+    tag'' (TagAttrib s) (x, y, z, as) = (x, s : y, z, as)+    tag'' (TagAttribs s) (x, y, z, as) = (x, y, z, s : as)+     ident :: Parser Ident     ident = Ident <$> many1 (alphaNum <|> char '_' <|> char '\'') @@ -264,19 +273,21 @@         _ <- char '<'         name' <- many  $ noneOf " \t.#\r\n!>"         let name = if null name' then "div" else name'-        xs <- many $ try ((many $ oneOf " \t") >>-              (tagIdent <|> tagCond <|> tagClass Nothing <|> tagAttrib Nothing))-        _ <- many $ oneOf " \t"-        c <- (eol >> return []) <|> (char '>' >> content InContent)-        let (tn, attr, classes) = tag' $ TagName name : xs+        xs <- many $ try ((many $ oneOf " \t\r\n") >>+              (tagIdent <|> tagCond <|> tagClass Nothing <|> tagAttrs <|> tagAttrib Nothing))+        _ <- many $ oneOf " \t\r\n"+        _ <- char '>'+        c <- 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+          else return $ LineTag tn attr c classes attrsd  data TagPiece = TagName String               | TagIdent [Content]               | TagClass (Maybe Deref, [Content])-              | TagAttrib (Maybe Deref, String, [Content])+              | TagAttrib (Maybe Deref, String, Maybe [Content])+              | TagAttribs Deref     deriving Show  data ContentRule = InQuotes | NotInQuotes | NotInQuotesAttr | InContent@@ -330,9 +341,9 @@     cases <- mapM getOf inside     rest' <- nestToDoc set rest     Ok $ DocCase d cases : rest'-nestToDoc set (Nest (LineTag tn attrs content classes) inside:rest) = do+nestToDoc set (Nest (LineTag tn attrs content classes attrsD) inside:rest) = do     let attrFix (x, y, z) = (x, y, [(Nothing, z)])-    let takeClass (a, "class", b) = Just (a, b)+    let takeClass (a, "class", b) = Just (a, fromMaybe [] b)         takeClass _ = Nothing     let clazzes = classes ++ mapMaybe takeClass attrs     let notClass (_, x, _) = x /= "class"@@ -340,7 +351,7 @@     let attrs' =             case clazzes of               [] -> map attrFix noclass-              _ -> (Nothing, "class", clazzes)+              _ -> (Nothing, "class", map (second Just) clazzes)                        : map attrFix noclass     let closeStyle =             if not (null content) || not (null inside)@@ -361,6 +372,7 @@     rest' <- nestToDoc set rest     Ok $ start        : attrs''+      ++ map (DocContent . ContentAttrs) attrsD       ++ seal        : map DocContent content       ++ inside'@@ -408,12 +420,12 @@     ds <- nestToDoc set ns     return $ compressDoc ds -attrToContent :: (Maybe Deref, String, [(Maybe Deref, [Content])]) -> [Doc]+attrToContent :: (Maybe Deref, String, [(Maybe Deref, Maybe [Content])]) -> [Doc] attrToContent (Just cond, k, v) =     [DocCond [(cond, attrToContent (Nothing, k, v))] Nothing] attrToContent (Nothing, k, []) = [DocContent $ ContentRaw $ ' ' : k]-attrToContent (Nothing, k, [(Nothing, [])]) = [DocContent $ ContentRaw $ ' ' : k]-attrToContent (Nothing, k, [(Nothing, v)]) =+attrToContent (Nothing, k, [(Nothing, Nothing)]) = [DocContent $ ContentRaw $ ' ' : k]+attrToContent (Nothing, k, [(Nothing, Just v)]) =     DocContent (ContentRaw (' ' : k ++ "=\""))   : map DocContent v   ++ [DocContent $ ContentRaw "\""]@@ -423,16 +435,16 @@     ++ go' (last v)     ++ [DocContent $ ContentRaw "\""]   where-    go (Nothing, x) = map DocContent x ++ [DocContent $ ContentRaw " "]+    go (Nothing, x) = map DocContent (fromMaybe [] x) ++ [DocContent $ ContentRaw " "]     go (Just b, x) =         [ DocCond-            [(b, map DocContent x ++ [DocContent $ ContentRaw " "])]+            [(b, map DocContent (fromMaybe [] x) ++ [DocContent $ ContentRaw " "])]             Nothing         ]-    go' (Nothing, x) = map DocContent x+    go' (Nothing, x) = maybe [] (map DocContent) x     go' (Just b, x) =         [ DocCond-            [(b, map DocContent x)]+            [(b, maybe [] (map DocContent) x)]             Nothing         ]
Text/Hamlet/RT.hs view
@@ -83,6 +83,9 @@         return $ SDTemplate y     convert (DocContent ContentMsg{}) =         error "Runtime hamlet does not currently support message interpolation"+    convert (DocContent ContentAttrs{}) =+        error "Runtime hamlet does not currently support attrs interpolation"+     convert x@(DocCond conds els) = do         conds' <- mapM go conds         els' <- maybe (return []) (mapM convert) els
hamlet.cabal view
@@ -1,14 +1,14 @@ name:            hamlet-version:         0.10.9.1+version:         1.0.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com> maintainer:      Michael Snoyman <michael@snoyman.com> synopsis:        Haml-like template files that are compile-time checked description:-    Hamlet gives you a type-safe tool for generating HTML code. It works via Quasi-Quoting, and generating extremely efficient output code. The syntax is white-space sensitive, and it helps you avoid cross-site scripting issues and 404 errors. Please see the documentation at <http://docs.yesodweb.com/book/hamlet/> for more details.+    Hamlet gives you a type-safe tool for generating HTML code. It works via Quasi-Quoting, and generating extremely efficient output code. The syntax is white-space sensitive, and it helps you avoid cross-site scripting issues and 404 errors. Please see the documentation at <http://www.yesodweb.com/book/shakespearean-templates> for more details.     .-    Here is a quick overview of hamlet html. Due to haddock escaping issues, we can't properly show variable insertion, but we are still going to show some conditionals. Please see <http://www.yesodweb.com/book/templates> for a thorough description+    Here is a quick overview of hamlet html. Due to haddock escaping issues, we can't properly show variable insertion, but we are still going to show some conditionals. Please see <http://www.yesodweb.com/book/shakespearean-templates> for a thorough description     .     > !!!     > <html>@@ -25,7 +25,7 @@ stability:       Stable cabal-version:   >= 1.8 build-type:      Simple-homepage:        http://www.yesodweb.com/book/templates+homepage:        http://www.yesodweb.com/book/shakespearean-templates extra-source-files:   test/hamlets/double-foralls.hamlet   test/hamlets/external-debug.hamlet@@ -41,14 +41,14 @@  library     build-depends:   base             >= 4       && < 5-                   , shakespeare      >= 0.10.2  && < 0.12+                   , shakespeare      >= 1.0     && < 1.1                    , bytestring       >= 0.9     && < 0.10                    , template-haskell                    , blaze-html       >= 0.4     && < 0.5                    , parsec           >= 2       && < 4                    , failure          >= 0.1     && < 0.3                    , text             >= 0.7     && < 0.12-                   , containers       >= 0.2     && < 0.5+                   , containers       >= 0.2                    , blaze-builder    >= 0.2     && < 0.4                    , process          >= 1.0     && < 1.2     exposed-modules: Text.Hamlet@@ -64,7 +64,7 @@     type: exitcode-stdio-1.0      ghc-options:   -Wall-    build-depends: hamlet           >= 0.10    && < 0.11+    build-depends: hamlet                  , base             >= 4       && < 5                  , parsec           >= 2       && < 4                  , containers       >= 0.2     && < 0.5
test/HamletTest.hs view
@@ -83,7 +83,7 @@ 
   , it "ignores a blank line" $ do
     helper "<p>foo</p>" [hamlet|
-<p
+<p>
 
     foo
 
@@ -96,7 +96,7 @@   , it "hamlet angle bracket syntax" $
       helper "<p class=\"foo\" height=\"100\"><span id=\"bar\" width=\"50\">HELLO</span></p>"
         [hamlet|
-<p.foo height="100"
+<p.foo height="100">
     <span #bar width=50>HELLO
 |]
 
@@ -158,7 +158,7 @@     helper "<p>1</p><p>2 not ignored</p>" [hamlet|
 <p>1
 <!-- ignored comment -->
-<p
+<p>
     2
     <!-- ignored --> not ignored<!-- ignored -->
 |]
@@ -192,13 +192,13 @@ 
   , it "conditional class" $ do
       helper "<p class=\"current\"></p>" 
-        [hamlet|<p :False:.ignored :True:.current|]
+        [hamlet|<p :False:.ignored :True:.current>|]
 
       helper "<p class=\"1 3 2 4\"></p>"
-        [hamlet|<p :True:.1 :True:class=2 :False:.a :False:class=b .3 class=4|]
+        [hamlet|<p :True:.1 :True:class=2 :False:.a :False:class=b .3 class=4>|]
 
       helper "<p class=\"foo bar baz\"></p>"
-        [hamlet|<p class=foo class=bar class=baz|]
+        [hamlet|<p class=foo class=bar class=baz>|]
 
 
 
@@ -265,10 +265,12 @@     $forall num <- [1, 2, 3]
         <li>#{show num}
 |]
+{-
   , it "infix operators" $
       helper "5" [hamlet|#{show $ (4 + 5) - (2 + 2)}|]
   , it "infix operators with parens" $
       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|
 $doctype 5
 $doctype strict
@@ -338,6 +340,20 @@         <dt>#{name}
         <dd>#{show age}
 |]
+
+  , it "multiline tags" $ helper
+      "<foo bar=\"baz\" bin=\"bin\">content</foo>" [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 *{attrs}>content
+|]
+  , it "blank attr values" $ helper
+      "<foo bar=\"\" baz bin=\"\"></foo>"
+      [hamlet|<foo bar="" baz bin=>|]
   ]
 
 data Pair = Pair String Int
@@ -425,11 +441,11 @@ caseTag :: Assertion
 caseTag = do
     helper "<p class=\"foo\"><div id=\"bar\">baz</div></p>" [hamlet|
-<p .foo
+<p .foo>
   <#bar>baz
 |]
     helper "<p class=\"foo.bar\"><div id=\"bar\">baz</div></p>" [hamlet|
-<p class=foo.bar
+<p class=foo.bar>
   <#bar>baz
 |]
 
@@ -560,30 +576,23 @@ |]
 
 caseScriptNotEmpty :: Assertion
-caseScriptNotEmpty = helper "<script></script>" [hamlet|<script|]
+caseScriptNotEmpty = helper "<script></script>" [hamlet|<script>|]
 
 caseMetaEmpty :: Assertion
 caseMetaEmpty = do
-    helper "<meta>" [hamlet|<meta|]
-    helper "<meta/>" [xhamlet|<meta|]
     helper "<meta>" [hamlet|<meta>|]
     helper "<meta/>" [xhamlet|<meta>|]
 
 caseInputEmpty :: Assertion
 caseInputEmpty = do
-    helper "<input>" [hamlet|<input|]
-    helper "<input/>" [xhamlet|<input|]
     helper "<input>" [hamlet|<input>|]
     helper "<input/>" [xhamlet|<input>|]
 
 caseMultiClass :: Assertion
-caseMultiClass = do
-    helper "<div class=\"foo bar\"></div>" [hamlet|<.foo.bar|]
-    helper "<div class=\"foo bar\"></div>" [hamlet|<.foo.bar>|]
+caseMultiClass = helper "<div class=\"foo bar\"></div>" [hamlet|<.foo.bar>|]
 
 caseAttribOrder :: Assertion
-caseAttribOrder = do
-    helper "<meta 1 2 3>" [hamlet|<meta 1 2 3|]
+caseAttribOrder =
     helper "<meta 1 2 3>" [hamlet|<meta 1 2 3>|]
 
 caseNothing :: Assertion
@@ -646,11 +655,11 @@ 
 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></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>"
-        [hamlet|<select :true theArg:selected|]
+        [hamlet|<select :true theArg:selected>|]
 
     helper "<select></select>" [hamlet|<select :False:selected>|]
     helper "<select selected></select>" [hamlet|<select :True:selected>|]
@@ -685,19 +694,19 @@ caseQuotedAttribs :: Assertion
 caseQuotedAttribs =
     helper "<input type=\"submit\" value=\"Submit response\">" [hamlet|
-<input type=submit value="Submit response"
+<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>" [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>" [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>" [hamlet|<##{var theArg}>|]
     helper "<div class=\"&lt;var&gt;\"></div>" [hamlet|<.#{var theArg}>|]
@@ -714,10 +723,10 @@     helper
       "<table><tbody><tr><td>1</td></tr><tr><td>2</td></tr></tbody></table>"
       [hamlet|
-<table
-  <tbody
+<table>
+  <tbody>
     $forall user <- users
-        <tr
+        <tr>
          <td>#{user}
 |]
     helper
@@ -728,8 +737,8 @@           , "</select>"
           ])
         [hamlet|
-<select #"#{name}" name=#{name}
-    <option :isBoolBlank val:selected
+<select #"#{name}" name=#{name}>
+    <option :isBoolBlank val:selected>
     <option value=true :isBoolTrue val:selected>Yes
     <option value=false :isBoolFalse val:selected>No
 |]
@@ -785,14 +794,14 @@ caseHamlet' = do
     helper' "foo" [shamlet|foo|]
     helper' "foo" [xshamlet|foo|]
-    helper "<br>" $ const $ [shamlet|<br|]
-    helper "<br/>" $ const $ [xshamlet|<br|]
+    helper "<br>" $ const $ [shamlet|<br>|]
+    helper "<br/>" $ 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>" $ const $ [shamlet|<br>|]
+    helper "<br/>" $ const $ [xshamlet|<br>|]
 
 
 instance Show Url where
test/hamlets/external.hamlet view
@@ -1,2 +1,2 @@ #{foo}-<br+<br>