Add @layer at-rule support to Lucius parser

Text/Internal/Css.hs

@@ -74,7 +74,7 @@ data TopLevel (a :: Resolved) where
     TopBlock   :: !(Block a) -> TopLevel a
     TopAtBlock :: !String -- name e.g., media
                -> !(Str a) -- selector
-               -> ![Block a]
+               -> ![TopLevel a]
                -> TopLevel a
     TopAtDecl  :: !String -> !(Str a) -> TopLevel a
     TopVar     :: !String -> !String -> TopLevel 'Unresolved
@@ -144,10 +144,10 @@ cssUsedIdentifiers toi2b parseBlocks s' =
           : cs
          ++ ContentRaw ";"
           : rest'
-    go (TopAtBlock _ _ blocks:rest) =
+    go (TopAtBlock _ _ nested:rest) =
         (scope1 ++ scope2, rest1 ++ rest2)
       where
-        (scope1, rest1) = go (map TopBlock blocks)
+        (scope1, rest1) = go nested
         (scope2, rest2) = go rest
     go (TopBlock (BlockUnresolved x y z):rest) =
         (scope1 ++ scope2, rest0 ++ rest1 ++ rest2)
@@ -286,8 +286,8 @@ cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do
     goTop scope (TopBlock b:rest) =
         map TopBlock (either error ($ []) $ blockRuntime (addScope scope) render' b) ++
         goTop scope rest
-    goTop scope (TopAtBlock name s' b:rest) =
-        TopAtBlock name s (foldr (either error id . blockRuntime (addScope scope) render') [] b) :
+    goTop scope (TopAtBlock name s' nested:rest) =
+        TopAtBlock name s (goTop scope nested) :
         goTop scope rest
       where
         s = either error mconcat $ mapM (contentToBuilderRT cd render') s'
@@ -340,7 +340,7 @@ lookupD _ _ = Nothing
 compressTopLevel :: TopLevel 'Unresolved
                  -> TopLevel 'Unresolved
 compressTopLevel (TopBlock b) = TopBlock $ compressBlock b
-compressTopLevel (TopAtBlock name s b) = TopAtBlock name s $ map compressBlock b
+compressTopLevel (TopAtBlock name s b) = TopAtBlock name s $ map compressTopLevel b
 compressTopLevel x@TopAtDecl{} = x
 compressTopLevel x@TopVar{} = x
 
@@ -459,9 +459,10 @@ topLevelsToCassius a = do
         e <- [|(++) $ map TopBlock ($(blockToCss r scope b) [])|]
         es <- go r scope rest
         return $ e : es
-    go r scope (TopAtBlock name s b:rest) = do
+    go r scope (TopAtBlock name s nested:rest) = do
         let s' = contentsToBuilder r scope s
-        e <- [|(:) $ TopAtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]
+        inner <- go r scope nested
+        e <- [|(:) $ TopAtBlock $(lift name) $(s') (foldr ($) [] $(return $ ListE inner))|]
         es <- go r scope rest
         return $ e : es
     go r scope (TopAtDecl dec cs:rest) = do
@@ -485,22 +486,27 @@ renderCss css =
         case css of
             CssWhitespace x -> (True, x)
             CssNoWhitespace x -> (False, x)
-    go (TopBlock x) = renderBlock haveWhiteSpace mempty x
-    go (TopAtBlock name s x) =
-        fromText (pack $ concat ["@", name, " "]) `mappend`
-        s `mappend`
-        startBlock `mappend`
-        foldr mappend endBlock (map (renderBlock haveWhiteSpace (fromString "    ")) x)
-    go (TopAtDecl dec cs) = fromText (pack $ concat ["@", dec, " "]) `mappend`
-                      cs `mappend`
-                      endDecl
+    go = goWith mempty
+
+    goWith indent (TopBlock x) = renderBlock haveWhiteSpace indent x
+    goWith indent (TopAtBlock name s x) =
+        indent <>
+        fromText (pack $ concat ["@", name, " "]) <> s <> startBlock <>
+        foldr mappend (endBlockWith indent) (map (goWith innerIndent) x)
+      where
+        innerIndent
+            | haveWhiteSpace = indent <> fromString "    "
+            | otherwise = mempty
+    goWith indent (TopAtDecl dec cs) =
+        indent <>
+        fromText (pack $ concat ["@", dec, " "]) <> cs <> endDecl
 
     startBlock
         | haveWhiteSpace = fromString " {\n"
         | otherwise = singleton '{'
 
-    endBlock
-        | haveWhiteSpace = fromString "}\n"
+    endBlockWith indent
+        | haveWhiteSpace = indent <> fromString "}\n"
         | otherwise = singleton '}'
 
     endDecl

Text/Internal/Lucius.hs

@@ -198,7 +198,7 @@ parseTopLevels order =
             ignore = many (whiteSpace1 <|> string' "<!--" <|> string' "-->")
                         >> return ()
         ignore
-        tl <- ((charset <|> media <|> impor <|> supports <|> topAtBlock <|> var <|> fmap TopBlock (parseBlock order)) >>= \x -> go (front . (:) x))
+        tl <- ((charset <|> media <|> impor <|> supports <|> layer <|> topAtBlock <|> var <|> fmap TopBlock (parseBlock order)) >>= \x -> go (front . (:) x))
             <|> (return $ map compressTopLevel $ front [])
         ignore
         return tl
@@ -224,6 +224,25 @@ parseTopLevels order =
         _ <- char '{'
         b <- parseBlocks id
         return $ TopAtBlock "supports" selector b
+    -- | @layer has two valid CSS forms:
+    -- Block form: @layer utilities { .class { prop: val; } }
+    -- Declaration form: @layer utilities; or @layer a, b, c;
+    -- Anonymous block: @layer { .class { prop: val; } } (no name)
+    layer = do
+        try $ stringCI "@layer "
+        -- Try block form first (including anonymous), then declaration form
+        try layerBlock <|> layerDecl
+      where
+        layerBlock = do
+            -- Use many instead of many1 to allow empty selector (anonymous layer)
+            selector <- many (parseContent "{")
+            _ <- char '{'
+            b <- parseBlocks id
+            return $ TopAtBlock "layer" selector b
+        layerDecl = do
+            val <- parseContents ";"
+            _ <- char ';'
+            return $ TopAtDecl "layer" val
     var = try $ do
         _ <- char '@'
         isPage <- (try $ string "page " >> return True) <|>
@@ -249,8 +268,11 @@ parseTopLevels order =
         return $ TopAtBlock name selector b
     parseBlocks front = do
         whiteSpace
-        (char '}' >> return (map compressBlock $ front []))
-            <|> ((parseBlock order) >>= \x -> parseBlocks (front . (:) x))
+        (char '}' >> return (map compressTopLevel $ front []))
+            <|> (nestedItem >>= \x -> parseBlocks (front . (:) x))
+      where
+        nestedItem = media <|> supports <|> layer <|> topAtBlock
+                 <|> fmap TopBlock (parseBlock order)
 
 stringCI :: String -> Parser ()
 stringCI [] = return ()
@@ -291,13 +313,13 @@ luciusRTInternal order tl =
         b' <- goBlock scope b
         rest' <- go scope rest
         Right $ map TopBlock b' ++ rest'
-    go scope (TopAtBlock name m' bs:rest) = do
+    go scope (TopAtBlock name m' nested:rest) = do
         let scope' = map goScope scope
             render = error "luciusRT has no URLs"
         m <- mapM (contentToBuilderRT scope' render) m'
-        bs' <- mapM (goBlock scope) bs
+        nested' <- go scope nested
         rest' <- go scope rest
-        Right $ TopAtBlock name (mconcat m) (concat bs') : rest'
+        Right $ TopAtBlock name (mconcat m) nested' : rest'
     go scope (TopVar k v:rest) = go ((pack k, RTVRaw $ pack v):scope) rest
 
     goBlock :: [(Text, RTValue)]

test/Text/CssSpec.hs

@@ -301,6 +301,66 @@ bin {
         }
         |]
 
+    it "lucius @layer block" $
+      celper "@layer utilities{.padding{padding:1rem}}" [lucius|
+        @layer utilities{
+            .padding { padding: 1rem; }
+        }
+        |]
+
+    it "lucius @layer declaration" $
+      celper "@layer utilities;" [lucius|
+        @layer utilities;
+        |]
+
+    it "lucius @layer multiple" $
+      celper "@layer utilities, components;" [lucius|
+        @layer utilities, components;
+        |]
+
+    it "lucius @layer anonymous" $
+      celper "@layer {.padding{padding:1rem}}" [lucius|
+        @layer {
+            .padding { padding: 1rem; }
+        }
+        |]
+
+    it "lucius @media inside @layer" $
+      celper "@layer components {@media only screen {.btn{font-size:1.5rem}}}" [lucius|
+        @layer components {
+            @media only screen {
+                .btn { font-size: 1.5rem; }
+            }
+        }
+        |]
+
+    it "lucius @layer inside @media" $
+      celper "@media (max-width: 600px) {@layer utilities {.hidden{display:none}}}" [lucius|
+        @media (max-width: 600px) {
+            @layer utilities {
+                .hidden { display: none; }
+            }
+        }
+        |]
+
+    it "lucius @supports inside @layer" $
+      celper "@layer base {@supports (display: grid) {.grid{display:grid}}}" [lucius|
+        @layer base {
+            @supports (display: grid) {
+                .grid { display: grid; }
+            }
+        }
+        |]
+
+    it "lucius @media inside @media" $
+      celper "@media screen {@media (min-width: 768px) {.container{max-width:720px}}}" [lucius|
+        @media screen {
+            @media (min-width: 768px) {
+                .container { max-width: 720px; }
+            }
+        }
+        |]
+
     {-
     it "cassius removes whitespace" $ do
       celper "foo{bar:baz}" [cassius|
@@ -953,6 +1013,66 @@ bin {
         }
         |]
 
+    it "lucius @layer block (ordered)" $
+      celper "@layer utilities{.padding{padding:1rem}}" [Ordered.lucius|
+        @layer utilities{
+            .padding { padding: 1rem; }
+        }
+        |]
+
+    it "lucius @layer declaration (ordered)" $
+      celper "@layer utilities;" [Ordered.lucius|
+        @layer utilities;
+        |]
+
+    it "lucius @layer multiple (ordered)" $
+      celper "@layer utilities, components;" [Ordered.lucius|
+        @layer utilities, components;
+        |]
+
+    it "lucius @layer anonymous (ordered)" $
+      celper "@layer {.padding{padding:1rem}}" [Ordered.lucius|
+        @layer {
+            .padding { padding: 1rem; }
+        }
+        |]
+
+    it "lucius @media inside @layer (ordered)" $
+      celper "@layer components {@media only screen {.btn{font-size:1.5rem}}}" [Ordered.lucius|
+        @layer components {
+            @media only screen {
+                .btn { font-size: 1.5rem; }
+            }
+        }
+        |]
+
+    it "lucius @layer inside @media (ordered)" $
+      celper "@media (max-width: 600px) {@layer utilities {.hidden{display:none}}}" [Ordered.lucius|
+        @media (max-width: 600px) {
+            @layer utilities {
+                .hidden { display: none; }
+            }
+        }
+        |]
+
+    it "lucius @supports inside @layer (ordered)" $
+      celper "@layer base {@supports (display: grid) {.grid{display:grid}}}" [Ordered.lucius|
+        @layer base {
+            @supports (display: grid) {
+                .grid { display: grid; }
+            }
+        }
+        |]
+
+    it "lucius @media inside @media (ordered)" $
+      celper "@media screen {@media (min-width: 768px) {.container{max-width:720px}}}" [Ordered.lucius|
+        @media screen {
+            @media (min-width: 768px) {
+                .container { max-width: 720px; }
+            }
+        }
+        |]
+
     {-
     it "cassius removes whitespace" $ do
       celper "foo{bar:baz}" [cassius|