shakespeare 2.0.27 → 2.0.29
raw patch · 6 files changed
+74/−27 lines, 6 filesnew-uploader
Files
- ChangeLog.md +8/−0
- Text/Internal/Css.hs +25/−11
- Text/Shakespeare/Base.hs +1/−1
- Text/Shakespeare/I18N.hs +1/−1
- shakespeare.cabal +1/−1
- test/Text/CssSpec.hs +38/−13
ChangeLog.md view
@@ -1,5 +1,13 @@ # ChangeLog for shakespeare +### 2.0.29++* Support the upcoming `template-haskell` release with GHC 9.4 [#267](https://github.com/yesodweb/shakespeare/pull/267)++### 2.0.28++* Add support for sub-blocks in mixins [#264](https://github.com/yesodweb/shakespeare/pull/264)+ ### 2.0.27 * Change how embedded templates are located by the compiler. Relative files are now resolved using the Cabal project root, to fix builds of multi-project codebases. [#266](https://github.com/yesodweb/shakespeare/pull/266)
Text/Internal/Css.hs view
@@ -67,7 +67,7 @@ data Mixin = Mixin { mixinAttrs :: ![Attr Resolved]- , mixinBlocks :: ![Block Resolved]+ , mixinBlocks :: ![(HasLeadingSpace, Block Resolved)] } deriving Lift instance Semigroup Mixin where@@ -176,6 +176,12 @@ parseBlocks'' <- parseBlocks' return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c +runtimePrependSelector :: Builder -> (HasLeadingSpace, Block Resolved) -> Block Resolved+runtimePrependSelector builder (hsl, Block x b () ()) =+ Block (builder <> addSpace x) b () ()+ where+ addSpace = if hsl then (TLB.singleton ' ' <>) else id+ combineSelectors :: HasLeadingSpace -> [Contents] -> [Contents]@@ -204,7 +210,9 @@ , blockAttrs = concat $ attrs' : map mixinAttrs mixins , blockBlocks = () , blockMixins = ()- } : foldr ($) rest z'+ }+ : fmap (runtimePrependSelector $ mconcat x') (concatMap mixinBlocks mixins)+ ++ foldr ($) rest z' {- (:) (Css' (mconcat $ map go' $ intercalate [ContentRaw "," ] x) (map go'' y)) . foldr (.) id (map (subGo x) z)@@ -345,24 +353,28 @@ -> Block Unresolved -> Q Exp blockToMixin r scope (Block _sel props subblocks mixins) =+ -- TODO: preserve the CPS in @mixinBlocks@ below [|Mixin { mixinAttrs = concat $ $(listE $ map go props) : map mixinAttrs $mixinsE- -- FIXME too many complications to implement sublocks for now...- , mixinBlocks = [] -- foldr (.) id $(listE $ map subGo subblocks) []- }|]- {-- . foldr (.) id $(listE $ map subGo subblocks)- . (concatMap mixinBlocks $mixinsE ++)+ , mixinBlocks = concat $(listE $ map subGo subblocks)+ } |]- -} where mixinsE = return $ ListE $ map (derefToExp []) mixins go (Attr x y) = conE 'Attr `appE` (contentsToBuilder r scope x) `appE` (contentsToBuilder r scope y)- subGo (Block sel' b c d) = blockToCss r scope $ Block sel' b c d+ -- We don't use the @hls@ to combine selectors, because the parent+ -- selector for a mixin is the dummy @mixin@ selector. But we may want+ -- to know later if the block needs a leading space, because the mixin+ -- might include an @&@ which needs to mix correctly with the parent+ -- block's selector.+ subGo (hls, Block sel' b c d) =+ [| map (\x -> ($(lift hls), x))+ $ $(blockToCss r scope $ Block sel' b c d) []+ |] blockToCss :: Name -> Scope@@ -378,7 +390,9 @@ , blockMixins = () } :: Block Resolved):) . foldr (.) id $(listE $ map subGo subblocks)- . (concatMap mixinBlocks $mixinsE ++)+ . (fmap (runtimePrependSelector $(selectorToBuilder r scope sel))+ (concatMap mixinBlocks $mixinsE)+ ++) |] where mixinsE = return $ ListE $ map (derefToExp []) mixins
Text/Shakespeare/Base.hs view
@@ -27,7 +27,7 @@ , readFileRecompileQ ) where -import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Syntax hiding (makeRelativeToProject) import Language.Haskell.TH (appE) import Data.Char (isUpper, isSymbol, isPunctuation, isAscii) import Data.FileEmbed (makeRelativeToProject)
Text/Shakespeare/I18N.hs view
@@ -61,7 +61,7 @@ , Lang ) where -import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Syntax hiding (makeRelativeToProject) import Control.Applicative ((<$>)) import Control.Monad (filterM, forM) import Data.Text (Text, pack, unpack)
shakespeare.cabal view
@@ -1,5 +1,5 @@ name: shakespeare-version: 2.0.27+version: 2.0.29 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>
test/Text/CssSpec.hs view
@@ -427,14 +427,11 @@ it "lucius mixins" $ do let bins = [luciusMixin| bin:bin2; - /* FIXME not currently implementing sublocks in mixins foo2 { - x: y + x: y; } - */ |] :: Mixin - -- No sublocks celper "foo{bar:baz;bin:bin2}foo foo2{x:y}" [lucius| - celper "foo{bar:baz;bin:bin2}" [lucius| + celper "foo{bar:baz;bin:bin2}foo foo2{x:y}" [lucius| foo { bar: baz; ^{bins} @@ -444,9 +441,11 @@ let bins = [cassiusMixin| bin:bin2 bin3:bin4 + + foo2 + x:y |] :: Mixin - -- No sublocks celper "foo{bar:baz;bin:bin2}foo foo2{x:y}" [lucius| - celper "foo{bar:baz;bin:bin2;bin3:bin4}" [lucius| + celper "foo{bar:baz;bin:bin2;bin3:bin4}foo foo2{x:y}" [lucius| foo { bar: baz; ^{bins} @@ -469,17 +468,43 @@ } |] + it "nested mixin blocks" $ do + let bar = [luciusMixin| + bar { + bin:baz; + } + |] + foo = [luciusMixin| + foo { + ^{bar} + } + |] :: Mixin + celper "selector foo bar{bin:baz}" [lucius| + selector { + ^{foo} + } + |] + + it "mixins with pseudoselectors" $ do + let bar = [luciusMixin| + &:hover { + bin:baz; + } + |] :: Mixin + celper "foo:hover{bin:baz}" [lucius| + foo { + ^{bar} + } + |] + it "runtime mixin" $ do let bins = [luciusMixin| bin:bin2; - /* FIXME not currently implementing sublocks in mixins foo2 { - x: y + x: y; } - */ |] :: Mixin - -- No sublocks celper "foo{bar:baz;bin:bin2}foo foo2{x:y}" [lucius| - Right (T.pack "foo{bar:baz;bin:bin2}") @=? luciusRTMixin + Right (T.pack "foo{bar:baz;bin:bin2}foo foo2{x:y}") @=? luciusRTMixin (T.pack "foo { bar: baz; ^{bins} }") True [(TS.pack "bins", RTVMixin bins)] @@ -576,7 +601,7 @@ -celper :: String -> CssUrl Url -> Assertion +celper :: HasCallStack => String -> CssUrl Url -> Assertion celper res h = do let x = renderCssUrl render h T.pack res @=? x