@@ -7,59 +7,65 @@ module Halogen.HTML.CSS
7
7
8
8
import Prelude
9
9
10
- import Data.Array (mapMaybe )
11
- import Data.Either (Either (), either )
12
- import Data.List (toUnfoldable , fromFoldable )
10
+ import CSS.Property (Key , Value )
11
+ import CSS.Render (render , renderedSheet , collect )
12
+ import CSS.Stylesheet (CSS , Rule (..), runS )
13
+
14
+ import Data.Array (mapMaybe , concatMap , singleton )
15
+ import Data.Either (Either )
16
+ import Data.Foldable (foldMap )
13
17
import Data.Maybe (Maybe (..), fromMaybe )
14
- import Data.String ( joinWith )
18
+ import Data.Newtype ( class Newtype )
15
19
import Data.StrMap as SM
20
+ import Data.String (joinWith )
16
21
import Data.Tuple (Tuple (..))
17
22
18
- import CSS.Property (Key (), Value ())
19
- import CSS.Render (render , renderedSheet , collect )
20
- import CSS.Stylesheet (CSS (), Rule (..), runS )
21
-
22
- import Halogen.HTML as H
23
- import Halogen.HTML.Core (HTML (), Prop (), class IsProp , prop , propName , attrName )
23
+ import Halogen.HTML as HH
24
+ import Halogen.HTML.Core (HTML , Prop , class IsProp , prop , propName , attrName )
25
+ import Halogen.HTML.Elements as HE
24
26
import Halogen.HTML.Properties as P
25
27
26
28
-- | A newtype for CSS styles
27
29
newtype Styles = Styles (SM.StrMap String )
28
30
29
- -- | Unpack CSS styles
30
- runStyles :: Styles -> SM.StrMap String
31
- runStyles (Styles m) = m
31
+ derive instance newtypeStyles ∷ Newtype Styles _
32
32
33
- instance stylesIsProp :: IsProp Styles where
34
- toPropString _ _ (Styles m) = joinWith " ; " $ (\(Tuple key value) -> key <> " : " <> value) <$> toUnfoldable (SM .toList m)
33
+ instance stylesIsProp ∷ IsProp Styles where
34
+ toPropString _ _ (Styles m) =
35
+ joinWith " ; " $ SM .foldMap (\key value → [key <> " : " <> value]) m
35
36
36
37
-- | Render a set of rules as an inline style.
37
38
-- |
38
39
-- | For example:
39
40
-- |
40
41
-- | ```purescript
41
- -- | H .div [ CSS.style do color red
42
+ -- | HH .div [ CSS.style do color red
42
43
-- | display block ]
43
44
-- | [ ... ]
44
45
-- | ```
45
- style :: forall i . CSS -> Prop i
46
- style = prop (propName " style" ) (Just $ attrName " style" ) <<< Styles <<< rules <<< runS
46
+ style ∷ ∀ i . CSS → Prop i
47
+ style =
48
+ prop (propName " style" ) (Just $ attrName " style" )
49
+ <<< Styles
50
+ <<< rules
51
+ <<< runS
47
52
where
48
- rules :: Array Rule -> SM.StrMap String
49
- rules rs = SM .fromList ( fromFoldable properties)
53
+ rules ∷ Array Rule → SM.StrMap String
54
+ rules rs = SM .fromFoldable properties
50
55
where
51
- properties :: Array (Tuple String String )
56
+ properties ∷ Array (Tuple String String )
52
57
properties = mapMaybe property rs >>= collect >>> rights
53
58
54
- property :: Rule -> Maybe (Tuple (Key Unit ) Value )
59
+ property ∷ Rule → Maybe (Tuple (Key Unit ) Value )
55
60
property (Property k v) = Just (Tuple k v)
56
61
property _ = Nothing
57
62
58
- rights :: forall a b . Array (Either a b ) -> Array b
59
- rights = mapMaybe (either (const Nothing ) Just )
63
+ rights ∷ ∀ a b . Array (Either a b ) → Array b
64
+ rights = concatMap $ foldMap singleton
60
65
61
66
-- | Render a set of rules as a `style` element.
62
- stylesheet :: forall p i . CSS -> HTML p i
63
- stylesheet css = H .style [ P .type_ " text/css" ] [ H .text content ]
67
+ stylesheet ∷ ∀ p i . CSS → HTML p i
68
+ stylesheet css =
69
+ HE .style [ P .type_ " text/css" ] [ HH .text content ]
64
70
where
65
71
content = fromMaybe " " $ renderedSheet $ render css
0 commit comments