shakespeare-css 1.0.3 → 1.0.4
raw patch · 4 files changed
+297/−112 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- Text/Css.hs +206/−90
- Text/Lucius.hs +57/−21
- shakespeare-css.cabal +1/−1
- test/ShakespeareCssTest.hs +33/−0
Text/Css.hs view
@@ -1,8 +1,11 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE EmptyDataDecls #-} module Text.Css where import Data.List (intersperse, intercalate)@@ -21,35 +24,69 @@ import Control.Arrow ((***)) import Text.IndentToBrace (i2b) import Data.Functor.Identity (runIdentity)+import Control.Monad (unless) +#if MIN_VERSION_base(4,5,0)+import Data.Monoid ((<>))+#else+(<>) :: Monoid m => m -> m -> m+(<>) = mappend+{-# INLINE (<>) #-}+#endif+ type CssUrl url = (url -> [(T.Text, T.Text)] -> T.Text) -> Css -pack :: String -> Text-pack = T.pack-#if !MIN_VERSION_text(0, 11, 2)-{-# NOINLINE pack #-}-#endif+type DList a = [a] -> [a] -fromText :: Text -> Builder-fromText = TLB.fromText-{-# NOINLINE fromText #-}+-- FIXME great use case for data kinds+data Resolved+data Unresolved -class ToCss a where- toCss :: a -> Builder+type family Selector a+type instance Selector Resolved = Builder+type instance Selector Unresolved = [Contents] -instance ToCss [Char] where toCss = fromLazyText . TL.pack-instance ToCss Text where toCss = fromText-instance ToCss TL.Text where toCss = fromLazyText+type family ChildBlocks a+type instance ChildBlocks Resolved = ()+type instance ChildBlocks Unresolved = [Block Unresolved] -data Css' = Css'- { _cssSelectors :: Builder- , _cssAttributes :: [(Builder, Builder)]+type family Str a+type instance Str Resolved = Builder+type instance Str Unresolved = Contents++type family Mixins a+type instance Mixins Resolved = ()+type instance Mixins Unresolved = [Deref]++data Block a = Block+ { blockSelector :: !(Selector a)+ , blockAttrs :: ![Attr a]+ , blockBlocks :: !(ChildBlocks a)+ , blockMixins :: !(Mixins a) }-data CssTop = AtBlock String Builder [Css'] | Css Css' | AtDecl String Builder -data Css = CssWhitespace [CssTop]- | CssNoWhitespace [CssTop]+data Mixin = Mixin+ { mixinAttrs :: ![Attr Resolved]+ , mixinBlocks :: ![Block Resolved]+ } +data TopLevel a where+ TopBlock :: !(Block a) -> TopLevel a+ TopAtBlock :: !String -- ^ name e.g., media+ -> !(Str a) -- ^ selector+ -> ![Block a]+ -> TopLevel a+ TopAtDecl :: !String -> !(Str a) -> TopLevel a+ TopVar :: !String -> !String -> TopLevel Unresolved++data Attr a = Attr+ { attrKey :: !(Str a)+ , attrVal :: !(Str a)+ }++data Css = CssWhitespace ![TopLevel Resolved]+ | CssNoWhitespace ![TopLevel Resolved]+ data Content = ContentRaw String | ContentVar Deref | ContentUrl Deref@@ -57,7 +94,6 @@ deriving (Show, Eq) type Contents = [Content]-type ContentPair = (Contents, Contents) data VarType = VTPlain | VTUrl | VTUrlParam deriving Show@@ -66,10 +102,27 @@ | CDUrl url | CDUrlParam (url, [(Text, Text)]) +pack :: String -> Text+pack = T.pack+#if !MIN_VERSION_text(0, 11, 2)+{-# NOINLINE pack #-}+#endif++fromText :: Text -> Builder+fromText = TLB.fromText+{-# NOINLINE fromText #-}++class ToCss a where+ toCss :: a -> Builder++instance ToCss [Char] where toCss = fromLazyText . TL.pack+instance ToCss Text where toCss = fromText+instance ToCss TL.Text where toCss = fromLazyText+ -- | Determine which identifiers are used by the given template, useful for -- creating systems like yesod devel. cssUsedIdentifiers :: Bool -- ^ perform the indent-to-brace conversion- -> Parser [TopLevel]+ -> Parser [TopLevel Unresolved] -> String -> [(Deref, VarType)] cssUsedIdentifiers toi2b parseBlocks s' =@@ -79,7 +132,8 @@ a = either (error . show) id $ parse parseBlocks s s (scope0, contents) = go a - go :: [TopLevel] -> ([(String, String)], [Content])+ go :: [TopLevel Unresolved]+ -> (Scope, [Content]) go [] = ([], []) go (TopAtDecl dec _FIXMEcs:rest) = (scope, rest'')@@ -96,7 +150,7 @@ where (scope1, rest1) = go (map TopBlock blocks) (scope2, rest2) = go rest- go (TopBlock (Block x y z):rest) =+ go (TopBlock (Block x y z _mixins):rest) = (scope1 ++ scope2, rest0 ++ rest1 ++ rest2) where rest0 = intercalate [ContentRaw ","] x ++ concatMap go' y@@ -106,10 +160,13 @@ ((k, v):scope, rest') where (scope, rest') = go rest- go' (k, v) = k ++ v+ go' (Attr k v) = k ++ v cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion- -> Q Exp -> Parser [TopLevel] -> FilePath -> Q Exp+ -> Q Exp+ -> Parser [TopLevel Unresolved]+ -> FilePath+ -> Q Exp cssFileDebug toi2b parseBlocks' parseBlocks fp = do s <- fmap TL.unpack $ qRunIO $ readUtf8File fp #ifdef GHC_7_4@@ -121,7 +178,7 @@ parseBlocks'' <- parseBlocks' return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c -combineSelectors :: Selector -> Selector -> Selector+combineSelectors :: [Contents] -> [Contents] -> [Contents] combineSelectors a b = do a' <- a b' <- b@@ -129,14 +186,20 @@ blockRuntime :: [(Deref, CDData url)] -> (url -> [(Text, Text)] -> Text)- -> Block- -> Either String ([Css'] -> [Css'])+ -> Block Unresolved+ -> Either String (DList (Block Resolved)) -- FIXME share code with blockToCss-blockRuntime cd render' (Block x y z) = do+blockRuntime cd render' (Block x attrs z mixins) = do+ unless (null mixins) $ Left "Runtime Lucius does not support mixins" x' <- mapM go' $ intercalate [ContentRaw ","] x- y' <- mapM go'' y+ attrs' <- mapM resolveAttr attrs z' <- mapM (subGo x) z -- FIXME use difflists again- Right $ \rest -> Css' (mconcat x') y' : foldr ($) rest z'+ Right $ \rest -> Block+ { blockSelector = mconcat x'+ , blockAttrs = attrs'+ , blockBlocks = ()+ , blockMixins = ()+ } : foldr ($) rest z' {- (:) (Css' (mconcat $ map go' $ intercalate [ContentRaw "," ] x) (map go'' y)) . foldr (.) id (map (subGo x) z)@@ -144,12 +207,14 @@ where go' = contentToBuilderRT cd render' - go'' :: ([Content], [Content]) -> Either String (Builder, Builder)- go'' (k, v) = (,) <$> (mconcat <$> mapM go' k) <*> (mconcat <$> mapM go' v)+ resolveAttr :: Attr Unresolved -> Either String (Attr Resolved)+ resolveAttr (Attr k v) = Attr <$> (mconcat <$> mapM go' k) <*> (mconcat <$> mapM go' v) - subGo :: Selector -> Block -> Either String ([Css'] -> [Css'])- subGo x' (Block a b c) =- blockRuntime cd render' (Block a' b c)+ subGo :: [Contents] -- ^ parent selectors+ -> Block Unresolved+ -> Either String (DList (Block Resolved))+ subGo x' (Block a b c d) =+ blockRuntime cd render' (Block a' b c d) where a' = combineSelectors x' a @@ -173,7 +238,7 @@ _ -> Left $ show d ++ ": expected CDUrlParam" cssRuntime :: Bool -- ^ i2b?- -> Parser [TopLevel]+ -> Parser [TopLevel Unresolved] -> FilePath -> [(Deref, CDData url)] -> (url -> [(Text, Text)] -> Text)@@ -184,17 +249,19 @@ let a = either (error . show) id $ parse parseBlocks s s return $ CssWhitespace $ goTop [] a where- goTop :: [(String, String)] -> [TopLevel] -> [CssTop]+ goTop :: [(String, String)] -- ^ scope+ -> [TopLevel Unresolved]+ -> [TopLevel Resolved] goTop _ [] = [] goTop scope (TopAtDecl dec cs':rest) =- AtDecl dec cs : goTop scope rest+ TopAtDecl dec cs : goTop scope rest where cs = either error mconcat $ mapM (contentToBuilderRT cd render') cs' goTop scope (TopBlock b:rest) =- map Css (either error ($[]) $ blockRuntime (addScope scope) render' b) +++ map TopBlock (either error ($[]) $ blockRuntime (addScope scope) render' b) ++ goTop scope rest goTop scope (TopAtBlock name s' b:rest) =- AtBlock name s (foldr (either error id . blockRuntime (addScope scope) render') [] b) :+ TopAtBlock name s (foldr (either error id . blockRuntime (addScope scope) render') [] b) : goTop scope rest where s = either error mconcat $ mapM (contentToBuilderRT cd render') s'@@ -235,52 +302,74 @@ Just _ -> Just s lookupD _ _ = Nothing -data Block = Block Selector Pairs [Block]- deriving Show--data TopLevel = TopBlock Block- | TopAtBlock- { _atBlockName :: String- , _atBlockSelector :: Contents- , _atBlockInner :: [Block]- }- | TopAtDecl String Contents- | TopVar String String--type Pairs = [Pair]--type Pair = (Contents, Contents)--type Selector = [Contents]--compressTopLevel :: TopLevel -> TopLevel+compressTopLevel :: TopLevel Unresolved+ -> TopLevel Unresolved compressTopLevel (TopBlock b) = TopBlock $ compressBlock b compressTopLevel (TopAtBlock name s b) = TopAtBlock name s $ map compressBlock b compressTopLevel x@TopAtDecl{} = x compressTopLevel x@TopVar{} = x -compressBlock :: Block -> Block-compressBlock (Block x y blocks) =- Block (map cc x) (map go y) (map compressBlock blocks)+compressBlock :: Block Unresolved+ -> Block Unresolved+compressBlock (Block x y blocks mixins) =+ Block (map cc x) (map go y) (map compressBlock blocks) mixins where- go (k, v) = (cc k, cc v)+ go (Attr k v) = Attr (cc k) (cc v) cc [] = [] cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c cc (a:b) = a : cc b -blockToCss :: Name -> Scope -> Block -> Q Exp-blockToCss r scope (Block sel props subblocks) =- [|(:) (Css' $(selectorToBuilder r scope sel) $(listE $ map go props))+blockToMixin :: Name+ -> Scope+ -> Block Unresolved+ -> Q Exp+blockToMixin r scope (Block _sel props subblocks mixins) =+ [|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 ++) |]+ -} where- go (x, y) = tupE [contentsToBuilder r scope x, contentsToBuilder r scope y]- subGo (Block sel' b c) =- blockToCss r scope $ Block sel'' b c+ 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++blockToCss :: Name+ -> Scope+ -> Block Unresolved+ -> Q Exp+blockToCss r scope (Block sel props subblocks mixins) =+ [|((Block+ { blockSelector = $(selectorToBuilder r scope sel)+ , blockAttrs = concat+ $ $(listE $ map go props)+ : map mixinAttrs $mixinsE+ , blockBlocks = ()+ , blockMixins = ()+ } :: Block Resolved):)+ . foldr (.) id $(listE $ map subGo subblocks)+ . (concatMap mixinBlocks $mixinsE ++)+ |]+ 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 where sel'' = combineSelectors sel sel' -selectorToBuilder :: Name -> Scope -> Selector -> Q Exp+selectorToBuilder :: Name -> Scope -> [Contents] -> Q Exp selectorToBuilder r scope sels = contentsToBuilder r scope $ intercalate [ContentRaw ","] sels @@ -305,46 +394,50 @@ type Scope = [(String, String)] -topLevelsToCassius :: [TopLevel] -> Q Exp+topLevelsToCassius :: [TopLevel Unresolved]+ -> Q Exp topLevelsToCassius a = do r <- newName "_render" lamE [varP r] $ appE [|CssNoWhitespace . foldr ($) []|] $ fmap ListE $ go r [] a where go _ _ [] = return [] go r scope (TopBlock b:rest) = do- e <- [|(++) $ map Css ($(blockToCss r scope b) [])|]+ e <- [|(++) $ map TopBlock ($(blockToCss r scope b) [])|] es <- go r scope rest return $ e : es go r scope (TopAtBlock name s b:rest) = do let s' = contentsToBuilder r scope s- e <- [|(:) $ AtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]+ e <- [|(:) $ TopAtBlock $(lift name) $(s') $(blocksToCassius r scope b)|] es <- go r scope rest return $ e : es go r scope (TopAtDecl dec cs:rest) = do- e <- [|(:) $ AtDecl $(lift dec) $(contentsToBuilder r scope cs)|]+ e <- [|(:) $ TopAtDecl $(lift dec) $(contentsToBuilder r scope cs)|] es <- go r scope rest return $ e : es go r scope (TopVar k v:rest) = go r ((k, v) : scope) rest -blocksToCassius :: Name -> Scope -> [Block] -> Q Exp+blocksToCassius :: Name+ -> Scope+ -> [Block Unresolved]+ -> Q Exp blocksToCassius r scope a = do appE [|foldr ($) []|] $ listE $ map (blockToCss r scope) a renderCss :: Css -> TL.Text renderCss css =- toLazyText $ mconcat $ map go tops-- FIXME use a foldr+ toLazyText $ mconcat $ map go tops where (haveWhiteSpace, tops) = case css of CssWhitespace x -> (True, x) CssNoWhitespace x -> (False, x)- go (Css x) = renderCss' haveWhiteSpace mempty x- go (AtBlock name s 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 (renderCss' haveWhiteSpace (fromString " ")) x)- go (AtDecl dec cs) = fromText (pack $ concat ["@", dec, " "]) `mappend`+ foldr mappend endBlock (map (renderBlock haveWhiteSpace (fromString " ")) x)+ go (TopAtDecl dec cs) = fromText (pack $ concat ["@", dec, " "]) `mappend` cs `mappend` endDecl @@ -360,16 +453,19 @@ | haveWhiteSpace = fromString ";\n" | otherwise = singleton ';' -renderCss' :: Bool -> Builder -> Css' -> Builder-renderCss' _ _ (Css' _x []) = mempty-renderCss' haveWhiteSpace indent (Css' x y) =- startSelect- `mappend` x- `mappend` startBlock- `mappend` mconcat (intersperse endDecl $ map go' y)- `mappend` endBlock+renderBlock :: Bool -- ^ have whitespace?+ -> Builder -- ^ indentation+ -> Block Resolved+ -> Builder+renderBlock haveWhiteSpace indent (Block sel attrs () ())+ | null attrs = mempty+ | otherwise = startSelect+ <> sel+ <> startBlock+ <> mconcat (intersperse endDecl $ map renderAttr attrs)+ <> endBlock where- go' (k, v) = startDecl `mappend` k `mappend` colon `mappend` v+ renderAttr (Attr k v) = startDecl <> k <> colon <> v colon | haveWhiteSpace = fromString ": "@@ -394,3 +490,23 @@ endDecl | haveWhiteSpace = fromString ";\n" | otherwise = singleton ';'++instance Lift Mixin where+ lift (Mixin a b) = [|Mixin a b|]+instance Lift (Attr Unresolved) where+ lift (Attr k v) = [|Attr k v :: Attr Unresolved |]+instance Lift (Attr Resolved) where+ lift (Attr k v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |]++liftBuilder :: Builder -> Q Exp+liftBuilder b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|]++instance Lift Content where+ lift (ContentRaw s) = [|ContentRaw s|]+ lift (ContentVar d) = [|ContentVar d|]+ lift (ContentUrl d) = [|ContentUrl d|]+ lift (ContentUrlParam d) = [|ContentUrlParam d|]+instance Lift (Block Unresolved) where+ lift (Block a b c d) = [|Block a b c d|]+instance Lift (Block Resolved) where+ lift (Block a b () ()) = [|Block $(liftBuilder a) b () ()|]
Text/Lucius.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-}@@ -10,6 +11,9 @@ , luciusFile , luciusFileDebug , luciusFileReload+ -- ** Mixins+ , luciusMixin+ , Mixin -- ** Runtime , luciusRT , luciusRT'@@ -54,7 +58,6 @@ import Numeric (readHex) import Control.Applicative ((<$>)) import Control.Monad (when, unless)-import Data.Either (partitionEithers) import Data.Monoid (mconcat) import Data.List (isSuffixOf) @@ -77,17 +80,26 @@ whiteSpace1 = ((oneOf " \t\n\r" >> return ()) <|> (parseComment >> return ())) -parseBlock :: Parser Block+parseBlock :: Parser (Block Unresolved) parseBlock = do sel <- parseSelector _ <- char '{' whiteSpace pairsBlocks <- parsePairsBlocks id- let (pairs, blocks) = partitionEithers pairsBlocks+ let (pairs, blocks, mixins) = partitionPBs pairsBlocks whiteSpace- return $ Block sel pairs blocks+ return $ Block sel pairs blocks mixins -parseSelector :: Parser Selector+partitionPBs :: [PairBlock] -> ([Attr Unresolved], [Block Unresolved], [Deref])+partitionPBs =+ go id id id+ where+ go a b c [] = (a [], b [], c [])+ go a b c (PBAttr x:xs) = go (a . (x:)) b c xs+ go a b c (PBBlock x:xs) = go a (b . (x:)) c xs+ go a b c (PBMixin x:xs) = go a b (c . (x:)) xs++parseSelector :: Parser (Selector Unresolved) parseSelector = go id where@@ -108,18 +120,25 @@ trimS True = dropWhile isSpace trimS False = reverse . dropWhile isSpace . reverse -type PairBlock = Either Pair Block+data PairBlock = PBAttr (Attr Unresolved)+ | PBBlock (Block Unresolved)+ | PBMixin Deref parsePairsBlocks :: ([PairBlock] -> [PairBlock]) -> Parser [PairBlock] parsePairsBlocks front = (char '}' >> return (front [])) <|> (do isBlock <- lookAhead checkIfBlock- x <- if isBlock- then (do- b <- parseBlock- whiteSpace- return $ Right b)- else Left <$> parsePair+ x <- grabMixin <|> (if isBlock then grabBlock else grabPair) parsePairsBlocks $ front . (:) x) where+ grabBlock = do+ b <- parseBlock+ whiteSpace+ return $ PBBlock b+ grabPair = PBAttr <$> parsePair+ grabMixin = try $ do+ whiteSpace+ Right x <- parseCaret+ whiteSpace+ return $ PBMixin x checkIfBlock = do skipMany $ noneOf "#@{};" (parseHash >> checkIfBlock)@@ -129,7 +148,7 @@ <|> (anyChar >> checkIfBlock) <|> fail "checkIfBlock" -parsePair :: Parser Pair+parsePair :: Parser (Attr Unresolved) parsePair = do key <- parseContents ":" _ <- char ':'@@ -137,7 +156,7 @@ val <- parseContents ";}" (char ';' >> return ()) <|> return () whiteSpace- return (key, val)+ return $ Attr key val parseContents :: String -> Parser Contents parseContents = many1 . parseContent@@ -189,7 +208,7 @@ luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels luciusFileReload = luciusFileDebug -parseTopLevels :: Parser [TopLevel]+parseTopLevels :: Parser [TopLevel Unresolved] parseTopLevels = go id where@@ -250,34 +269,39 @@ stringCI [] = return () stringCI (c:cs) = (char (toLower c) <|> char (toUpper c)) >> stringCI cs -luciusRT' :: TL.Text -> Either String ([(Text, Text)] -> Either String [CssTop])+luciusRT' :: TL.Text+ -> Either String ([(Text, Text)] -> Either String [TopLevel Resolved]) luciusRT' tl = case parse parseTopLevels (TL.unpack tl) (TL.unpack tl) of Left s -> Left $ show s Right tops -> Right $ \scope -> go scope tops where- go :: [(Text, Text)] -> [TopLevel] -> Either String [CssTop]+ go :: [(Text, Text)]+ -> [TopLevel Unresolved]+ -> Either String [TopLevel Resolved] go _ [] = Right [] go scope (TopAtDecl dec cs':rest) = do let scope' = map goScope scope render = error "luciusRT has no URLs" cs <- mapM (contentToBuilderRT scope' render) cs' rest' <- go scope rest- Right $ AtDecl dec (mconcat cs) : rest'+ Right $ TopAtDecl dec (mconcat cs) : rest' go scope (TopBlock b:rest) = do b' <- goBlock scope b rest' <- go scope rest- Right $ map Css b' ++ rest'+ Right $ map TopBlock b' ++ rest' go scope (TopAtBlock name m' bs:rest) = do let scope' = map goScope scope render = error "luciusRT has no URLs" m <- mapM (contentToBuilderRT scope' render) m' bs' <- mapM (goBlock scope) bs rest' <- go scope rest- Right $ AtBlock name (mconcat m) (concat bs') : rest'+ Right $ TopAtBlock name (mconcat m) (concat bs') : rest' go scope (TopVar k v:rest) = go ((pack k, pack v):scope) rest - goBlock :: [(Text, Text)] -> Block -> Either String [Css']+ goBlock :: [(Text, Text)]+ -> Block Unresolved+ -> Either String [Block Resolved] goBlock scope = either Left (Right . ($[])) . blockRuntime scope' (error "luciusRT has no URLs") where@@ -298,3 +322,15 @@ -- creating systems like yesod devel. luciusUsedIdentifiers :: String -> [(Deref, VarType)] luciusUsedIdentifiers = cssUsedIdentifiers False parseTopLevels++luciusMixin :: QuasiQuoter+luciusMixin = QuasiQuoter { quoteExp = luciusMixinFromString }++luciusMixinFromString :: String -> Q Exp+luciusMixinFromString s' = do+ r <- newName "_render"+ case fmap compressBlock $ parse parseBlock s s of+ Left e -> error $ show e+ Right block -> blockToMixin r [] block+ where+ s = concat ["mixin{", s', "}"]
shakespeare-css.cabal view
@@ -1,5 +1,5 @@ name: shakespeare-css-version: 1.0.3+version: 1.0.4 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>
test/ShakespeareCssTest.hs view
@@ -396,6 +396,39 @@ } } |] + it "mixins" $ do + let bins = [luciusMixin| + bin:bin2; + /* FIXME not currently implementing sublocks in mixins + foo2 { + x: y + } + */ + |] :: Mixin + -- No sublocks celper "foo{bar:baz;bin:bin2}foo foo2{x:y}" [lucius| + celper "foo{bar:baz;bin:bin2}" [lucius| + foo { + bar: baz; + ^{bins} + } + |] + it "more complicated mixins" $ do + let transition val = + [luciusMixin| + -webkit-transition: #{val}; + -moz-transition: #{val}; + -ms-transition: #{val}; + -o-transition: #{val}; + transition: #{val}; + |] + + celper ".some-class{-webkit-transition:all 4s ease;-moz-transition:all 4s ease;-ms-transition:all 4s ease;-o-transition:all 4s ease;transition:all 4s ease}" + [lucius| + .some-class { + ^{transition "all 4s ease"} + } + |] + data Url = Home | Sub SubUrl data SubUrl = SubUrl