Cleaning up style handling a bit

package.yaml

@@ -70,7 +70,6 @@ tests:
     - -with-rtsopts=-N
     - -main-is Spec
     dependencies:
-    - purview
     - QuickCheck                    >= 2.14.2 && < 2.15
     - hspec                         >= 2.7.10 && < 2.12
     - time                          >= 1.9.3 && < 1.14

purview.cabal

@@ -118,7 +118,6 @@ test-suite purview-test
     , bytestring >=0.10.12.0 && <0.13
     , hspec >=2.7.10 && <2.12
     , http-types >=0.12.3 && <0.13
-    , purview
     , raw-strings-qq ==1.1.*
     , stm >=2.5.0 && <2.6
     , template-haskell >=2.15.0 && <2.21

src/CleanTree.hs

@@ -9,15 +9,14 @@ import Data.List
 import Component
 
 
+{-
 
+I think I can just remove this special handling?
+
+-}
 removeClassCSS :: [(Hash, String)] -> Attributes e -> Attributes e
 removeClassCSS foundCSS attr = case attr of
-  Style (hash, css) ->
-    if hash /= "-1"
-    then case find (== (hash, css)) foundCSS of
-      Just _  -> Style (hash, "")
-      Nothing -> Style (hash, css)
-    else attr
+  style@Style {} -> style { captured=True }
   _ -> attr
 
 cleanTree :: Typeable event => [(Hash, String)] -> Purview event m -> Purview event m

src/CollectInitials.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 -- |
 
@@ -12,9 +13,9 @@ type Location = [Int]
 
 getStyleFromAttr :: Attributes e -> Maybe (Hash, String)
 getStyleFromAttr attr = case attr of
-  Style (hash, css) ->
-    if hash /= "-1" && css /= ""
-    then Just (hash, css)  -- set the css to empty since it's been caught
+  Style { captured, hash, css } ->
+    if not captured
+    then Just (hash, css)
     else Nothing
   _ -> Nothing
 

src/Component.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -8,6 +9,7 @@ import           Data.Typeable
 import           Events
 
 type Hash = String
+type Captured = Bool
 
 {-|
 
@@ -25,14 +27,17 @@ data Attributes event where
      -> (Maybe String -> event)  -- the string here is information from the browser
      -> Attributes event
         -- ^ part of creating handlers for different events, e.g. On "click"
-  Style :: (Hash, String) -> Attributes event
-        -- ^ hash of the css, the css
+  Style :: { captured :: Bool
+           , hash :: String
+           , css :: String
+           } -> Attributes event
+        -- ^ used only for class based css, inline css is just a generic
   Generic :: String -> String -> Attributes event
         -- ^ for creating new Attributes to put on HTML, e.g. Generic "type" "radio" for type="radio".
 
 instance Eq (Attributes event) where
-  (Style a) == (Style b) = a == b
-  (Style _) == _ = False
+  (Style { hash=hashA }) == (Style { hash=hashB }) = hashA == hashB
+  (Style {}) == _ = False
 
   (On kind ident _event) == (On kind' ident' _event') =
     kind == kind' && ident == ident'
@@ -43,7 +48,7 @@ instance Eq (Attributes event) where
 
 instance Show (Attributes event) where
   show (On kind ident evt) = "On " <> show kind <> " " <> show ident
-  show (Style str) = "Style " <> show str
+  show (Style { hash, css }) = "Style " <> show (hash, css)
   show (Generic attrKey attrValue) = "Generic " <> show attrKey <> show attrValue
 
 {-|

src/ComponentHelpers.hs

@@ -307,7 +307,7 @@ submitButton valid =
 @
 -}
 istyle :: String -> Purview event m -> Purview event m
-istyle str = Attribute $ Style ("-1", str)
+istyle = Attribute . Generic "style"
 
 {-|
 

src/Rendering.hs

@@ -19,18 +19,19 @@ isClass :: Attributes a -> Bool
 isClass (Generic "class" _) = True
 isClass _                   = False
 
-getStyle :: Attributes a -> String
-getStyle (Style (hash, style')) =
-  -- inline styles are just given a hash of -1
-  if hash == "-1" then style' else ""
-getStyle _ = ""
+isInlineStyle :: Attributes a -> Bool
+isInlineStyle (Generic "style" _) = True
+isInlineStyle _                   = False
+
+getInlineStyle :: Attributes a -> String
+getInlineStyle (Generic "style" css) = css
+getInlineStyle _                     = ""
 
 getClassBasedStyle :: Attributes a -> String
-getClassBasedStyle (Style (hash, style')) =
-  -- earlier we set the style' to "" to say it's been captured
-  -- also filter out things like "p123 li", which are created
+getClassBasedStyle (Style { hash, css }) =
+  -- filter out things like "p123 li", which are created
   -- by nested rules in [style||] templates
-  if style' == "" && not (' ' `elem` hash) then hash else ""
+  if ' ' `notElem` hash then hash else ""
 getClassBasedStyle _ = ""
 
 renderGeneric :: Attributes a -> String
@@ -41,7 +42,8 @@ renderGeneric attr = case attr of
 renderAttributes :: [Attributes a] -> String
 renderAttributes attrs =
   let
-    styles = concatMap getStyle attrs
+    -- doesn't work like this anymore
+    styles = concatMap getInlineStyle attrs
     renderedStyle = if not (null styles) then " style=" <> show styles else ""
 
     -- TODO: this is uggo
@@ -60,7 +62,7 @@ renderAttributes attrs =
       listeners
     noticeToBind = if null listeners then "" else " bubbling-bound"
 
-    generics = filter (not . isClass) $ filter isGeneric attrs
+    generics = filter (not . (\v -> isClass v || isInlineStyle v)) $ filter isGeneric attrs
     renderedGenerics = concatMap renderGeneric generics
   in
     renderedStyle <> noticeToBind <> renderedListeners <> renderedGenerics <> renderedClasses

src/Style.hs

@@ -140,9 +140,9 @@ toAttributes hashed css =
   let ((_, baseCss):rest) = handleCSS css
   in foldr
       (\(newClass, newCss) acc ->
-         acc . Attribute (Style (combineClasses hashed newClass, newCss))
+         acc . Attribute (Style False (combineClasses hashed newClass) newCss)
       )
-      (Attribute (Style (hashed, baseCss))) rest
+      (Attribute (Style False hashed baseCss)) rest
 
 style' :: String -> Q Exp
 style' css =

test/PrepareTreeSpec.hs

@@ -161,7 +161,7 @@ spec = parallel $ do
     it "picks up css" $ do
       let
         component :: Purview () m
-        component = (Attribute $ Style ("123", "color: blue;")) $ div []
+        component = (Attribute $ Style { captured=False, hash="123", css="color: blue;" }) $ div []
 
         (_, css) = collectInitials component :: ([Event], [(Hash, String)])
 

test/RenderingSpec.hs

@@ -110,22 +110,22 @@ spec = parallel $ do
         "<div handler=\"[0,1]\" parent-handler=\"[]\" receiver-name=\"test\"><div></div></div>"
 
     it "can render a class based style" $ do
-      let component = (Attribute $ Style ("123", "")) $ div []
+      let component = (Attribute $ Style { captured=False, hash="123", css="" }) $ div []
 
       render component
         `shouldBe`
         "<div class=\"123\"></div>"
 
     it "can render multile class based style" $ do
-      let style = Attribute $ Style ("123", "")
+      let style = Attribute $ Style { captured=False, hash="123", css="" }
           component = style $ style (div [])
 
       render component
         `shouldBe`
         "<div class=\"123 123\"></div>"
 
     it "can combine an existing class and class based style" $ do
-      let style = Attribute $ Style ("123", "")
+      let style = Attribute $ Style { captured=False, hash="123", css="" }
           component = class' "abc" $ style (div [])
 
       render component

test/StyleSpec.hs

@@ -109,6 +109,10 @@ spec = parallel $ do
         let result = handleCSS "&:hover { color: green; }"
         result `shouldBe` [("&:hover ","color: green;")]
 
+      it "works with only a subnode style" $ do
+        let result = parseCSS [] "\na { color: blue; }"
+        result `shouldBe` [("a ", "color: blue;")]
+
 
 
 main :: IO ()