@@ -15,24 +15,15 @@ import Data.Array (mapMaybe, concatMap, singleton)
1515import Data.Either (Either )
1616import Data.Foldable (foldMap )
1717import Data.Maybe (Maybe (..), fromMaybe )
18- import Data.Newtype ( class Newtype )
18+ import Data.MediaType ( MediaType (..) )
1919import Data.StrMap as SM
2020import Data.String (joinWith )
2121import Data.Tuple (Tuple (..))
2222
2323import Halogen.HTML as HH
24- import Halogen.HTML.Core (HTML , Prop , class IsProp , prop , propName , attrName )
2524import Halogen.HTML.Elements as HE
26- import Halogen.HTML.Properties as P
27-
28- -- | A newtype for CSS styles
29- newtype Styles = Styles (SM.StrMap String )
30-
31- derive instance newtypeStyles ∷ Newtype Styles _
32-
33- instance stylesIsProp ∷ IsProp Styles where
34- toPropString _ _ (Styles m) =
35- joinWith " ; " $ SM .foldMap (\key value → [key <> " : " <> value]) m
25+ import Halogen.HTML.Properties as HP
26+ import Halogen.HTML.Core as HC
3627
3728-- | Render a set of rules as an inline style.
3829-- |
@@ -43,13 +34,16 @@ instance stylesIsProp ∷ IsProp Styles where
4334-- | display block ]
4435-- | [ ... ]
4536-- | ```
46- style ∷ ∀ i . CSS → Prop i
37+ style ∷ ∀ i r . CSS → HP.IProp ( style ∷ String | r ) i
4738style =
48- prop (propName " style " ) ( Just $ attrName " style" )
49- <<< Styles
39+ HP. prop (HC.PropName " style" )
40+ <<< toString
5041 <<< rules
5142 <<< runS
5243 where
44+ toString ∷ SM.StrMap String → String
45+ toString = joinWith " ; " <<< SM.foldMap (\key val → [ key <> " : " <> val ])
46+
5347 rules ∷ Array Rule → SM.StrMap String
5448 rules rs = SM.fromFoldable properties
5549 where
@@ -64,8 +58,8 @@ style =
6458 rights = concatMap $ foldMap singleton
6559
6660-- | Render a set of rules as a `style` element.
67- stylesheet ∷ ∀ p i . CSS → HTML p i
61+ stylesheet ∷ ∀ p i . CSS → HC. HTML p i
6862stylesheet css =
69- HE .style [ P .type_ " text/css" ] [ HH .text content ]
63+ HE .style [ HP .type_ $ MediaType " text/css" ] [ HH .text content ]
7064 where
7165 content = fromMaybe " " $ renderedSheet $ render css
0 commit comments