shakespeare 2.1.7.1 → 2.2.0

raw patch · 6 files changed

+139/−1 lines, 6 files

Files

• ChangeLog.md +41/−0
• Text/Hamlet.hs +17/−0
• Text/Hamlet/Parse.hs +17/−0
• Text/Hamlet/RT.hs +1/−0
• shakespeare.cabal +1/−1
• test/Text/HamletSpec.hs +62/−0

@@ -1,5 +1,46 @@ # ChangeLog for shakespeare +### 2.2.0++* Added $component with binding for reusable blocks++You can now bind a component-producing function and reuse its sub-components within the same Hamlet block.++#### Example++```haskell+data Modal = Modal+  { modalHeader :: Widget -> Widget+  , modalBody   :: Widget -> Widget+  }++modalWidget :: (Modal -> Widget) -> Widget+```++```hamlet+$component modal <- modalWidget+  $component modalHeader modal+    <h1>This is the title++  $component modalBody modal+    <p>This is the content+```++Conceptually, this desugars to:++```haskell+^{ modalWidget $ \modal ->+     [whamlet|+       ^{ modalHeader modal [whamlet| <h1>This is the title |] }+       ^{ modalBody   modal [whamlet| <p>This is the content |] }+     |]+ }+<p>outside+```++Since everything here is just plain Haskell, you can freely pass additional data or parameters to your component-producing function—`modalWidget` and its subcomponents are ordinary functions.+Only the *outermost* component (`modalWidget` in this case) needs to follow the `(Modal -> Widget) -> Widget` pattern; all nested subcomponents can have arbitrary types and arguments.+ ### 2.1.7.1  * Add missing other-messages to shakespeare.cabal [#299](https://github.com/yesodweb/shakespeare/pull/299)

@@ -216,6 +216,22 @@     inside' <- docToExp env hr scope' (DocWith dis inside)     let lam = LamE [pat] inside'     return $ lam `AppE` deref'+docToExp env hr scope (DocComponent mbinding deref inside) = do+    let deref' = derefToExp scope deref+    case mbinding of+        Just binding -> do+            (pat, extraScope) <- bindingPattern binding+            let scope' = extraScope ++ scope+            inside' <-+                hrWithEnv hr $ \env ->+                    docsToExp env hr scope' inside+            hrEmbed hr env $ deref' `AppE` LamE [pat] inside'+        Nothing -> do+            inside' <-+                hrWithEnv hr $ \env ->+                    docsToExp env hr scope inside+            hrEmbed hr env $ deref' `AppE` inside'+ docToExp env hr scope (DocMaybe val idents inside mno) = do     let val' = derefToExp scope val     (pat, extraScope) <- bindingPattern idents@@ -594,6 +610,7 @@     justContent (DocContent c) = c     justContent DocForall{} = unsupported "$forall"     justContent DocWith{} = unsupported "$with"+    justContent DocComponent{} = unsupported "$component"     justContent DocMaybe{} = unsupported "$maybe"     justContent DocCase{} = unsupported "$case"     justContent DocCond{} = unsupported "attribute conditionals"

@@ -66,6 +66,7 @@           | LineNothing           | LineCase Deref           | LineOf Binding+          | LineComponent (Maybe Binding) Deref           | LineTag             { _lineTagName :: String             , _lineAttr :: [(Maybe Deref, String, Maybe [Content])]@@ -125,6 +126,7 @@          controlWith <|>          controlCase <|>          controlOf <|>+         controlComponent <|>          angle <|>          invalidDollar <|>          (eol' >> return (LineContent [] True)) <|>@@ -238,6 +240,14 @@         _   <- spaceTabs         eol         return $ LineOf x+    controlComponent = do+        _ <- try $ string "$component"+        spaces+        (x, b) <- (second Just <$> try binding) <|>+                  ((\x -> (x, Nothing)) <$> parseDeref)+        _ <- spaceTabs+        eol+        return $ LineComponent b x     content cr = do         x <- many $ content' cr         case cr of@@ -450,6 +460,7 @@          | DocCond [(Deref, [Doc])] (Maybe [Doc])          | DocMaybe Deref Binding [Doc] (Maybe [Doc])          | DocCase Deref [(Binding, [Doc])]+         | DocComponent (Maybe Binding) Deref [Doc]          | DocContent Content     deriving (Show, Eq, Read, Data, Typeable) @@ -486,6 +497,10 @@     cases <- mapM getOf inside     rest' <- nestToDoc set rest     Ok $ DocCase d cases : rest'+nestToDoc set (Nest (LineComponent b d) inside:rest) = do+    inside' <- nestToDoc set inside+    rest' <- nestToDoc set rest+    Ok $ DocComponent b d inside' : rest' 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)@@ -546,6 +561,8 @@     DocForall d i (compressDoc doc) : compressDoc rest compressDoc (DocWith dis doc:rest) =     DocWith dis (compressDoc doc) : compressDoc rest+compressDoc (DocComponent b d i:rest) =+    DocComponent b d i : compressDoc rest compressDoc (DocMaybe d i doc mnothing:rest) =     DocMaybe d i (compressDoc doc) (fmap compressDoc mnothing)   : compressDoc rest

@@ -112,6 +112,7 @@             docs'' <- mapM convert docs'             return (deref', docs'')     convert DocWith{} = error "Runtime hamlet does not currently support $with"+    convert DocComponent{} = error "Runtime hamlet does not currently support $component"     convert DocCase{} = error "Runtime hamlet does not currently support $case"  renderHamletRT :: MonadThrow m

@@ -1,5 +1,5 @@ name:            shakespeare-version:         2.1.7.1+version:         2.2.0 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>

@@ -22,6 +22,11 @@ import Text.Blaze.Internal (preEscapedString)
 import Text.Blaze
 
+data ExampleModal widget = ExampleModal
+    { modalHeader :: widget -> widget,
+      modalContent :: widget -> widget
+    }
+
 spec = do
     it "empty" caseEmpty
     it "static" caseStatic
@@ -518,6 +523,63 @@                     }"
                 >
             |]
+
+    it "supports $component without binding" $
+        let
+            container :: String -> HtmlUrl url -> HtmlUrl url
+            container clazz x =
+                [hamlet|
+                    $newline never
+                    <div class="container #{clazz}">
+                        ^{x}
+                |]
+        in
+            helper "<div class=\"container alert\"><p>Hello world</p></div><p>outside</p>"
+                [hamlet|
+                    $newline never
+                    $component container "alert"
+                      <p>Hello world
+                    <p>outside
+                |]
+
+    it "supports $component with binding (modal example)" $
+        let
+            modalWidget :: (ExampleModal (HtmlUrl url) -> HtmlUrl url) -> HtmlUrl url
+            modalWidget body =
+              let
+                exampleModal =
+                    ExampleModal
+                      { modalHeader = \content ->
+                            [hamlet|
+                                $newline never
+                                <div class="modal-header">
+                                    ^{content}
+                            |],
+                        modalContent = \content ->
+                            [hamlet|
+                                $newline never
+                                <div class="modal-content">
+                                    ^{content}
+                            |]
+                      }
+              in
+                [hamlet|
+                    $newline never
+                    <div class="modal">
+                        ^{body exampleModal}
+                |]
+        in
+            helper "<div class=\"modal\"><div class=\"modal-header\"><h1>This is the title</h1></div><div class=\"modal-content\"><p>This is the content</p></div></div><p>outside</p>"
+                [hamlet|
+                    $newline never
+                    $component modal <- modalWidget
+                        $component modalHeader modal
+                          <h1>This is the title
+
+                        $component modalContent modal
+                          <p>This is the content
+                    <p>outside
+                |]
 
     it "runtime Hamlet with caret interpolation" $ do
         let toInclude render = render (5, [("hello", "world")])