plzwrk 0.0.0.5 → 0.0.0.6

raw patch · 7 files changed

+94/−49 lines, 7 files

Files

ChangeLog.md +4/−0
README.md +1/−0
plzwrk.cabal +1/−1
src/Web/Framework/Plzwrk.hs +1/−1
src/Web/Framework/Plzwrk/TH/HSX.hs +38/−25
src/Web/Framework/Plzwrk/TH/QuoteHSX.hs +37/−22
test/HSXSpec.hs +12/−0

ChangeLog.md view

@@ -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

README.md view

@@ -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

plzwrk.cabal view

@@ -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 <https://github.com/meeshkan/plzwrk#readme>

src/Web/Framework/Plzwrk.hs view

@@ -25,7 +25,7 @@   -- hsx
   , hsx
   , hsx'
-  , hmFromList
+  , plusplus
   -- util
   , pF
   , pT

src/Web/Framework/Plzwrk/TH/HSX.hs view

@@ -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

src/Web/Framework/Plzwrk/TH/QuoteHSX.hs view

@@ -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 =

test/HSXSpec.hs view

@@ -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|<a click=#c{(\_ x -> return $ x + 41)}#>Hello</a>|]+    let dom = [hsx|+            <h1 id="foo" style="position:absolute">+                #el{take 10 $ repeat mylink}#+                #t{"hello world"}#+            </h1>+        |]+    _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|<a click=#c{(\_ x -> return $ x + 41)}#>Hello</a>|]     let dom = (\st -> [hsx'|