diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for plzwrk +## 0.0.0.6 + +- Adds `#el` mixin for element lists. + ## 0.0.0.5 - Adds bounds for cabal packages diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -79,6 +79,7 @@ `hsx` is not unlike `jsx`. The main difference is that instead of using just `{}`, `hsx` uses three different varieties of `#{}#` - `#e{}#` for an element +- `#el{}#` for a list of elements - `#t{}#` for a text node or text attribute - `#c{}#` for a callback attribute diff --git a/plzwrk.cabal b/plzwrk.cabal --- a/plzwrk.cabal +++ b/plzwrk.cabal @@ -7,7 +7,7 @@ -- hash: 8099ceb0d406f862d89306de053aba4c75999a9e0d74ac6a502458d503e7dcc1 name: plzwrk -version: 0.0.0.5 +version: 0.0.0.6 category: Web synopsis: A front-end framework description: Please see the README on GitHub at diff --git a/src/Web/Framework/Plzwrk.hs b/src/Web/Framework/Plzwrk.hs --- a/src/Web/Framework/Plzwrk.hs +++ b/src/Web/Framework/Plzwrk.hs @@ -25,7 +25,7 @@ -- hsx , hsx , hsx' - , hmFromList + , plusplus -- util , pF , pT diff --git a/src/Web/Framework/Plzwrk/TH/HSX.hs b/src/Web/Framework/Plzwrk/TH/HSX.hs --- a/src/Web/Framework/Plzwrk/TH/HSX.hs +++ b/src/Web/Framework/Plzwrk/TH/HSX.hs @@ -24,6 +24,7 @@ data HSX = HSXElement String [(String, HSXAttribute)] [HSX] | HSXSelfClosingTag String [(String, HSXAttribute)] | HSXHaskellCode String + | HSXHaskellCodeList String | HSXHaskellText String | HSXBody String deriving (Show, Eq) @@ -40,13 +41,20 @@ ws close <- try (string "/>" <|> string ">") if (length close) == 2 - then return (HSXSelfClosingTag name attr) - else do - elementHSXBody <- manyTill elementHSXBody (endTag name) - ws - return (HSXElement name attr elementHSXBody) + then return (HSXSelfClosingTag name attr) + else do + elementHSXBody <- manyTill elementHSXBody (endTag name) + ws + return (HSXElement name attr elementHSXBody) -elementHSXBody = ws *> (try tag <|> try haskellCodeNode <|> try haskellTxtNode <|> text) +elementHSXBody = + ws + *> ( try tag + <|> try haskellCodeNode + <|> try haskellCodeNodes + <|> try haskellTxtNode + <|> text + ) endTag :: String -> Parser String endTag str = string " string str <* char '>' @@ -67,7 +75,7 @@ makeBracketed cmd contain = do let start = ("#" <> cmd <> "{") - let end = "}#" + let end = "}#" string start value <- manyTill anyChar (string end) ws @@ -82,13 +90,18 @@ value <- makeBracketed "e" False return $ HSXHaskellCode value +haskellCodeNodes :: Parser HSX +haskellCodeNodes = do + value <- makeBracketed "el" False + return $ HSXHaskellCodeList value + haskellTxtNode :: Parser HSX haskellTxtNode = do value <- makeBracketed "t" False return $ HSXHaskellText value attribute = do - name <- many (noneOf "= />") + name <- many (noneOf "= />") ws char '=' ws @@ -100,22 +113,22 @@ ws = void $ many $ oneOf " \t\r\n" parseHSX :: MonadFail m => (String, Int, Int) -> String -> m HSX -parseHSX (file, line, col) s = - case runParser p () "" s of - Left err -> fail $ show err - Right e -> return e - where - p = do updatePosition file line col - ws - e <- hsx - ws - eof - return e +parseHSX (file, line, col) s = case runParser p () "" s of + Left err -> fail $ show err + Right e -> return e + where + p = do + updatePosition file line col + ws + e <- hsx + ws + eof + return e updatePosition file line col = do - pos <- getPosition - setPosition $ - (flip setSourceName) file $ - (flip setSourceLine) line $ - (flip setSourceColumn) col $ - pos + pos <- getPosition + setPosition + $ (flip setSourceName) file + $ (flip setSourceLine) line + $ (flip setSourceColumn) col + $ pos diff --git a/src/Web/Framework/Plzwrk/TH/QuoteHSX.hs b/src/Web/Framework/Plzwrk/TH/QuoteHSX.hs --- a/src/Web/Framework/Plzwrk/TH/QuoteHSX.hs +++ b/src/Web/Framework/Plzwrk/TH/QuoteHSX.hs @@ -1,7 +1,7 @@ module Web.Framework.Plzwrk.TH.QuoteHSX ( hsx , hsx' - , hmFromList + , plusplus ) where @@ -39,8 +39,8 @@ returnQ (parseExp y) -hmFromList :: (Eq k, H.Hashable k) => [(k, v)] -> HM.HashMap k v -hmFromList = HM.fromList +plusplus :: [a] -> [a] -> [a] +plusplus = (++) hsxAttributeToExpQ :: (String, HSXAttribute) -> TH.Q TH.Exp hsxAttributeToExpQ (k, HSXStringAttribute v) = TH.tupE @@ -65,30 +65,45 @@ wrapInLambda True e = TH.lamE [TH.varP (TH.mkName "_")] e wrapInLambda False e = e -hsxToExpQ :: Bool -> HSX -> TH.Q TH.Exp -hsxToExpQ lam (HSXHaskellCode y ) = haskize y -hsxToExpQ lam (HSXHaskellText y ) = wrapInLambda True $ TH.appE (TH.conE (TH.mkName "PwTextNode")) (haskize y) -hsxToExpQ lam (HSXElement tag attrs elts) = wrapInLambda lam $ foldl - TH.appE - (TH.conE (TH.mkName "PwElement")) - [ TH.litE (TH.StringL tag) - , TH.listE (fmap hsxAttributeToExpQ attrs) - , TH.listE (fmap (\x -> hsxToExpQ True x) elts) - ] -hsxToExpQ lam (HSXSelfClosingTag tag attrs) = wrapInLambda lam $ foldl - TH.appE - (TH.conE (TH.mkName "PwElement")) - [ (TH.litE (TH.StringL tag)) - , TH.listE (fmap hsxAttributeToExpQ attrs) - , (TH.conE (TH.mkName "[]")) - ] -hsxToExpQ lam (HSXBody b) = wrapInLambda lam +asList :: Bool -> TH.Q TH.Exp -> TH.Q TH.Exp +asList b e = if b then TH.listE [e] else e + +hsxToExpQ :: Bool -> Bool -> HSX -> TH.Q TH.Exp +hsxToExpQ lam returnAsList (HSXHaskellCode y) = asList returnAsList (haskize y) +hsxToExpQ lam returnAsList (HSXHaskellCodeList y) = haskize y +hsxToExpQ lam returnAsList (HSXHaskellText y) = asList + returnAsList + (wrapInLambda True $ TH.appE (TH.conE (TH.mkName "PwTextNode")) (haskize y)) +hsxToExpQ lam returnAsList (HSXElement tag attrs elts) = asList + returnAsList + (wrapInLambda lam $ foldl + TH.appE + (TH.conE (TH.mkName "PwElement")) + [ TH.litE (TH.StringL tag) + , TH.listE (fmap hsxAttributeToExpQ attrs) + , foldl TH.appE (TH.varE (TH.mkName "foldr")) [(TH.varE (TH.mkName "plusplus")), (TH.conE (TH.mkName "[]")), TH.listE (fmap (\x -> hsxToExpQ True True x) elts)] + ] + ) +hsxToExpQ lam returnAsList (HSXSelfClosingTag tag attrs) = asList + returnAsList + (wrapInLambda lam $ foldl + TH.appE + (TH.conE (TH.mkName "PwElement")) + [ (TH.litE (TH.StringL tag)) + , TH.listE (fmap hsxAttributeToExpQ attrs) + , (TH.conE (TH.mkName "[]")) + ] + ) +hsxToExpQ lam returnAsList (HSXBody b) = asList + returnAsList + ( wrapInLambda lam $ TH.appE (TH.conE (TH.mkName "PwTextNode")) (TH.litE (TH.StringL b)) + ) quoteExprExp b s = do pos <- getPosition result <- parseHSX pos s - hsxToExpQ b result + hsxToExpQ b False result getPosition = fmap transPos TH.location where transPos loc = diff --git a/test/HSXSpec.hs b/test/HSXSpec.hs --- a/test/HSXSpec.hs +++ b/test/HSXSpec.hs @@ -45,6 +45,18 @@ _elt_tag (((_elt_children (dom 5)) !! 0) 3) `shouldBe` "a" _tn_text (((_elt_children (dom 5)) !! 1) 3) `shouldBe` "hello world" 1 `shouldBe` 1 + it "Parses hsx with a list of elements" $ do + let mylink = [hsx| return $ x + 41)}#>Hello|] + let dom = [hsx| +

+ #el{take 10 $ repeat mylink}# + #t{"hello world"}# +

+ |] + _elt_tag (dom 3) `shouldBe` "h1" + _elt_tag (((_elt_children (dom 5)) !! 0) 3) `shouldBe` "a" + _elt_tag (((_elt_children (dom 5)) !! 6) 3) `shouldBe` "a" + _tn_text (((_elt_children (dom 5)) !! 10) 3) `shouldBe` "hello world" it "Parses hsx'" $ do let mylink = [hsx| return $ x + 41)}#>Hello|] let dom = (\st -> [hsx'|