Add some support for media queries

Author: puffnfresh

site/Main.purs

@@ -11,6 +11,7 @@ import Css.Font
 import Css.FontFace
 import Css.Geometry
 import Css.Gradient
+import qualified Css.Media as M
 import Css.Pseudo
 import Css.Render
 import Css.Selector
@@ -80,6 +81,10 @@ style = do
 
   keyframes "buzz-button" $ tuple2 50 (shake id) NEL.:| [tuple2 100 (shake negate)]
 
+  query M.screen (NEL.singleton <<< M.maxWidth $ px 768) $
+    h1 ? do
+      fontSize (em 2)
+
   html ? height (pct 100)
   body ? do
     fontFamily ["Lato"] (NEL.singleton sansSerif)

src/Css/Media.purs

@@ -0,0 +1,13 @@
+module Css.Media where
+
+import Css.Property
+import Css.Size
+import Css.String
+import Css.Stylesheet
+import Data.Maybe
+
+screen :: MediaType
+screen = MediaType $ fromString "screen"
+
+maxWidth :: Size Abs -> Feature
+maxWidth = Feature "max-width" <<< Just <<< value

src/Css/Property.purs

@@ -1,10 +1,11 @@
 module Css.Property where
 
 import Css.String
+import Data.Foldable
+import Data.Maybe
 import Data.Monoid
 import Data.Profunctor.Strong
 import Data.Tuple
-import Data.Foldable
 import qualified Data.Array.NonEmpty as NEL
 
 data Prefixed = Prefixed [Tuple String String]
@@ -22,6 +23,10 @@ instance semigroupPrefixed :: Semigroup Prefixed where
 instance monoidPrefixed :: Monoid Prefixed where
   mempty = Plain mempty
 
+plain :: Prefixed -> String
+plain (Prefixed xs) = fromMaybe "" $ lookup "" xs
+plain (Plain    p ) = p
+
 -- TODO: Escape
 quote :: String -> String
 quote s = "\"" <> s <> "\""

src/Css/Render.purs

@@ -63,24 +63,39 @@ frame :: Number -> [Rule] -> String
 frame p rs = show p <> "% " <> "{ " <> x <> " }"
   where x = fromMaybe "" <<< renderedInline $ rules [] rs
 
+query' :: MediaQuery -> [App] -> [Rule] -> Rendered
+query' q sel rs = Just <<< That <<< Sheet $ mediaQuery q <> " { " <> fromMaybe "" (renderedSheet $ rules sel rs) <> " }\n"
+
+mediaQuery :: MediaQuery -> String
+mediaQuery (MediaQuery no ty fs) = "@media " <> mediaType ty <> NEL.sconcat ((" and " <>) <<< feature <$> fs)
+
+mediaType :: MediaType -> String
+mediaType (MediaType (Value s)) = plain s
+
+feature :: Feature -> String
+feature (Feature k mv) = maybe k (\(Value v) -> "(" <> k <> ": " <> plain v <> ")") mv
+
 face :: [Rule] -> Rendered
 face rs = Just <<< That <<< Sheet $ "@font-face { " <> fromMaybe "" (renderedInline $ rules [] rs) <> " }\n"
 
 rules :: [App] -> [Rule] -> Rendered
-rules sel rs = topRules <> importRules <> keyframeRules <> faceRules <> nestedSheets
+rules sel rs = topRules <> importRules <> keyframeRules <> faceRules <> nestedSheets <> queryRules
   where property (Property k v) = Just (Tuple k v)
         property _              = Nothing
         nested   (Nested a ns ) = Just (Tuple a ns)
         nested   _              = Nothing
+        queries  (Query  q ns ) = Just (Tuple q ns)
+        queries  _              = Nothing
         kframes  (Keyframe fs ) = Just fs
         kframes  _              = Nothing
         faces    (Face ns     ) = Just ns
         faces    _              = Nothing
         imports  (Import i    ) = Just i
         imports  _              = Nothing
         topRules      = rule' sel (mapMaybe property rs)
-        nestedSheets  = intercalate (Just (That (Sheet " "))) $ uncurry nestedRules <$> mapMaybe nested rs
+        nestedSheets  = foldMap (<> (Just <<< That $ Sheet "\n")) $ uncurry nestedRules <$> mapMaybe nested rs
         nestedRules a = rules (a : sel)
+        queryRules    = foldMap (uncurry $ flip query' sel) $ mapMaybe queries rs
         keyframeRules = foldMap kframe $ mapMaybe kframes rs
         faceRules     = foldMap face   $ mapMaybe faces   rs
         importRules   = foldMap imp    $ mapMaybe imports rs

src/Css/Stylesheet.purs

@@ -13,7 +13,7 @@ newtype MediaType = MediaType Value
 
 data NotOrOnly = Not | Only
 
-data MediaQuery = MediaQuery (Maybe NotOrOnly) MediaType [Feature]
+data MediaQuery = MediaQuery (Maybe NotOrOnly) MediaType (NEL.NonEmpty Feature)
 
 data Feature = Feature String (Maybe Value)
 
@@ -63,6 +63,9 @@ infixr 5 ?
 (?) :: Selector -> Css -> Css
 (?) sel rs = rule $ Nested (Sub sel) (runS rs)
 
+query :: MediaType -> NEL.NonEmpty Feature -> Css -> Css
+query ty fs = rule <<< Query (MediaQuery Nothing ty fs) <<< runS
+
 keyframes :: String -> NEL.NonEmpty (Tuple Number Css) -> Css
 keyframes n xs = rule $ Keyframe (Keyframes n (second runS <$> xs))