From 60836dc0ff54bf6ab4bf6b8973444ca1e1d9ed41 Mon Sep 17 00:00:00 2001 From: Myoungjin JEON Date: Fri, 6 Feb 2026 08:29:21 +1100 Subject: [PATCH 1/2] Add @layer at-rule support to Lucius parser CSS @layer allows explicit cascade layer ordering. This adds support for all three forms: - Block form: @layer utilities { .class { prop: val; } } - Declaration form: @layer utilities; or @layer a, b, c; - Anonymous block: @layer { .class { prop: val; } } The parser uses `many` instead of `many1` for the selector to support anonymous layers (empty selector). Co-Authored-By: Claude Opus 4.5 --- Text/Internal/Lucius.hs | 21 +++++++++++++++++- test/Text/CssSpec.hs | 48 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 68 insertions(+), 1 deletion(-) diff --git a/Text/Internal/Lucius.hs b/Text/Internal/Lucius.hs index 6d7371d..1db1f59 100644 --- a/Text/Internal/Lucius.hs +++ b/Text/Internal/Lucius.hs @@ -198,7 +198,7 @@ parseTopLevels order = ignore = many (whiteSpace1 <|> 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) <|> diff --git a/test/Text/CssSpec.hs b/test/Text/CssSpec.hs index 6aa0921..4c0977e 100755 --- a/test/Text/CssSpec.hs +++ b/test/Text/CssSpec.hs @@ -301,6 +301,30 @@ 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 "cassius removes whitespace" $ do celper "foo{bar:baz}" [cassius| @@ -953,6 +977,30 @@ 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 "cassius removes whitespace" $ do celper "foo{bar:baz}" [cassius| From 2e22d915369cf3be5924d28072ee2d78adb08ea7 Mon Sep 17 00:00:00 2001 From: Myoungjin JEON Date: Wed, 11 Feb 2026 17:28:15 +1100 Subject: [PATCH 2/2] Support nested at-rules in Lucius parser Change TopAtBlock to hold [TopLevel a] instead of [Block a], enabling recursive nesting of @media, @layer, @supports inside each other. Update parser, compressor, renderer, compile-time and runtime resolvers. Co-Authored-By: Claude Opus 4.6 --- Text/Internal/Css.hs | 44 ++++++++++++++----------- Text/Internal/Lucius.hs | 13 +++++--- test/Text/CssSpec.hs | 72 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 105 insertions(+), 24 deletions(-) diff --git a/Text/Internal/Css.hs b/Text/Internal/Css.hs index 5d6770f..6e1efd6 100644 --- a/Text/Internal/Css.hs +++ b/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 diff --git a/Text/Internal/Lucius.hs b/Text/Internal/Lucius.hs index 1db1f59..8c099ce 100644 --- a/Text/Internal/Lucius.hs +++ b/Text/Internal/Lucius.hs @@ -268,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 () @@ -310,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)] diff --git a/test/Text/CssSpec.hs b/test/Text/CssSpec.hs index 4c0977e..e9f24c3 100755 --- a/test/Text/CssSpec.hs +++ b/test/Text/CssSpec.hs @@ -325,6 +325,42 @@ bin { } |] + 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| @@ -1001,6 +1037,42 @@ bin { } |] + 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|