hamlet 0.10.5 → 0.10.6

raw patch · 5 files changed

+111/−3 lines, 5 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/Hamlet.hs +12/−0
• Text/Hamlet/Parse.hs +50/−0
• Text/Hamlet/RT.hs +1/−0
• hamlet.cabal +1/−1
• test/HamletTest.hs +47/−2

@@ -123,6 +123,18 @@         let d' = derefToExp scope d         docs' <- docsToExp env hr scope docs         return $ TupE [d', docs']+docToExp env hr scope (DocCase deref cases) = do+    let exp_ = derefToExp scope deref+    matches <- mapM toMatch cases+    return $ CaseE exp_ matches+  where+    toMatch (idents, inside) = do+        let pat = case map unIdent idents of+                    ["_"] -> WildP+                    strs -> let (constr:fields) = map mkName strs+                            in ConP constr (map VarP fields)+        insideExp <- docsToExp env hr scope inside+        return $ Match pat (NormalB insideExp) [] docToExp env hr v (DocContent c) = contentToExp env hr v c  contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp

@@ -50,6 +50,8 @@           | LineWith [(Deref, [Ident])]           | LineMaybe Deref [Ident]           | LineNothing+          | LineCase Deref+          | LineOf [Ident]           | LineTag             { _lineTagName :: String             , _lineAttr :: [(Maybe Deref, String, [Content])]@@ -70,6 +72,7 @@     ss <- fmap sum $ many ((char ' ' >> return 1) <|>                            (char '\t' >> fail "Tabs are not allowed in Hamlet indentation"))     x <- doctype <|>+         doctypeDollar <|>          comment <|>          htmlComment <|>          backslash <|>@@ -80,7 +83,10 @@          (try (string "$nothing") >> spaceTabs >> eol >> return LineNothing) <|>          controlForall <|>          controlWith <|>+         controlCase <|>+         controlOf <|>          angle <|>+         invalidDollar <|>          (eol' >> return (LineContent [])) <|>          (do             cs <- content InContent@@ -96,6 +102,17 @@     doctype = do         try $ string "!!!" >> eol         return $ LineContent [ContentRaw $ hamletDoctype set ++ "\n"]+    doctypeDollar = do+        _ <- try $ string "$doctype "+        name <- many $ noneOf "\r\n"+        eol+        case lookup name doctypeNames of+            Nothing -> fail $ "Unknown doctype name: " ++ name+            Just val -> return $ LineContent [ContentRaw $ val ++ "\n"]++    invalidDollar = do+        _ <- char '$'+        fail $ "Received a command I did not understand. If you wanted a literal $, start the line with a backslash."     comment = do         _ <- try $ string "$#"         _ <- many $ noneOf "\r\n"@@ -157,6 +174,19 @@         spaces         bindings <- (binding `sepBy` bindingSep) `endBy` eol         return $ LineWith $ concat bindings -- concat because endBy returns a [[(Deref,Ident)]]+    controlCase = do+        _ <- try $ string "$case"+        spaces+        x <- parseDeref+        _ <- spaceTabs+        eol+        return $ LineCase x+    controlOf = do+        _   <- try $ string "$of"+        pat <- many1 $ try $ spaces >> ident+        _   <- spaceTabs+        eol+        return $ LineOf pat     content cr = do         x <- many $ content' cr         case cr of@@ -254,6 +284,7 @@          | DocWith [(Deref, [Ident])] [Doc]          | DocCond [(Deref, [Doc])] (Maybe [Doc])          | DocMaybe Deref [Ident] [Doc] (Maybe [Doc])+         | DocCase Deref [([Ident], [Doc])]          | DocContent Content     deriving (Show, Eq, Read, Data, Typeable) @@ -282,6 +313,14 @@             _ -> return (Nothing, rest)     rest'' <- nestToDoc set rest'     Ok $ DocMaybe d i inside' nothing : rest''+nestToDoc set (Nest (LineCase d) inside:rest) = do+    let getOf (Nest (LineOf pat) insideC) = do+            insideC' <- nestToDoc set insideC+            Ok (pat, insideC')+        getOf _ = Error "Inside a $case there may only be $of.  Use '$of _' for a wildcard."+    cases <- mapM getOf inside+    rest' <- nestToDoc set rest+    Ok $ DocCase d cases : rest' nestToDoc set (Nest (LineTag tn attrs content classes) inside:rest) = do     let attrFix (x, y, z) = (x, y, [(Nothing, z)])     let takeClass (a, "class", b) = Just (a, b)@@ -326,6 +365,7 @@ nestToDoc _set (Nest (LineElseIf _) _:_) = Error "Unexpected elseif" nestToDoc _set (Nest LineElse _:_) = Error "Unexpected else" nestToDoc _set (Nest LineNothing _:_) = Error "Unexpected nothing"+nestToDoc _set (Nest (LineOf _) _:_) = Error "Unexpected 'of' (did you forget a $case?)"  compressDoc :: [Doc] -> [Doc] compressDoc [] = []@@ -341,6 +381,8 @@ compressDoc (DocCond x y:rest) =     DocCond (map (second compressDoc) x) (compressDoc `fmap` y)     : compressDoc rest+compressDoc (DocCase d cs:rest) =+    DocCase d (map (second compressDoc) cs) : compressDoc rest compressDoc (DocContent (ContentRaw ""):rest) = compressDoc rest compressDoc ( DocContent (ContentRaw x)             : DocContent (ContentRaw y)@@ -456,3 +498,11 @@     inside' <- nestToDoc set inside     parseConds set (front . (:) (d, inside')) rest parseConds _ front rest = Ok (front [], Nothing, rest)++doctypeNames :: [(String, String)]+doctypeNames =+    [ ("5", "<!DOCTYPE html>")+    , ("html", "<!DOCTYPE html>")+    , ("1.1", "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">")+    , ("strict", "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")+    ]

@@ -93,6 +93,7 @@             docs'' <- mapM convert docs'             return (deref', docs'')     convert DocWith{} = error "Runtime hamlet does not currently support $with"+    convert DocCase{} = error "Runtime hamlet does not currently support $case"  renderHamletRT :: Failure HamletException m                => HamletRT

@@ -1,5 +1,5 @@ name:            hamlet-version:         0.10.5+version:         0.10.6 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>

@@ -87,6 +87,7 @@ 
     foo
 
+
 |]
 
 
@@ -113,7 +114,7 @@ 
 
   , it "single dollar at and caret" $ do
-    helper "$@^" [hamlet|$@^|]
+    helper "$@^" [hamlet|\$@^|]
 
     helper "#{@{^{" [hamlet|#\{@\{^\{|]
 
@@ -260,6 +261,50 @@       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
+|]
+
+  , it "case on Maybe" $
+      let nothing  = Nothing
+          justTrue = Just True
+      in helper "<br><br><br><br>" [hamlet|
+$case nothing
+    $of Just val
+    $of Nothing
+        <br>
+$case justTrue
+    $of Just val
+        $if val
+            <br>
+    $of Nothing
+$case (Just $ not False)
+    $of Nothing
+    $of Just val
+        $if val
+            <br>
+$case Nothing
+    $of Just val
+    $of _
+        <br>
+|]
+
+  , it "case on Url" $
+      let url1 = Home
+          url2 = Sub SubUrl
+      in helper "<br><br>" [hamlet|
+$case url1
+    $of Home
+        <br>
+    $of _
+$case url2
+    $of Sub sub
+        $case sub
+            $of SubUrl
+                <br>
+    $of Home
+|]
   ]
 
 data Url = Home | Sub SubUrl
@@ -555,7 +600,7 @@ \
 \ 
 |]
-    helper "$@^" [hamlet|$@^|]
+    helper "$@^" [hamlet|\$@^|]
 
 caseEmptyStatementList :: Assertion
 caseEmptyStatementList = do