shakespeare-css 1.0.4 → 1.0.5

raw patch · 4 files changed

+48/−16 lines, 4 files

Files

• Text/Css.hs +23/−14
• Text/Lucius.hs +15/−1
• shakespeare-css.cabal +1/−1
• test/ShakespeareCssTest.hs +9/−0

@@ -21,7 +21,7 @@ import Text.Shakespeare.Base hiding (Scope) import Language.Haskell.TH import Control.Applicative ((<$>), (<*>))-import Control.Arrow ((***))+import Control.Arrow ((***), second) import Text.IndentToBrace (i2b) import Data.Functor.Identity (runIdentity) import Control.Monad (unless)@@ -48,8 +48,10 @@  type family ChildBlocks a type instance ChildBlocks Resolved = ()-type instance ChildBlocks Unresolved = [Block Unresolved]+type instance ChildBlocks Unresolved = [(HasLeadingSpace, Block Unresolved)] +type HasLeadingSpace = Bool+ type family Str a type instance Str Resolved = Builder type instance Str Unresolved = Contents@@ -72,8 +74,8 @@  data TopLevel a where     TopBlock   :: !(Block a) -> TopLevel a-    TopAtBlock :: !String -- ^ name e.g., media-               -> !(Str a) -- ^ selector+    TopAtBlock :: !String -- name e.g., media+               -> !(Str a) -- selector                -> ![Block a]                -> TopLevel a     TopAtDecl  :: !String -> !(Str a) -> TopLevel a@@ -154,7 +156,7 @@         (scope1 ++ scope2, rest0 ++ rest1 ++ rest2)       where         rest0 = intercalate [ContentRaw ","] x ++ concatMap go' y-        (scope1, rest1) = go (map TopBlock z)+        (scope1, rest1) = go (map (TopBlock . snd) z)         (scope2, rest2) = go rest     go (TopVar k v:rest) =         ((k, v):scope, rest')@@ -178,11 +180,18 @@     parseBlocks'' <- parseBlocks'     return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c -combineSelectors :: [Contents] -> [Contents] -> [Contents]-combineSelectors a b = do+combineSelectors :: HasLeadingSpace+                 -> [Contents]+                 -> [Contents]+                 -> [Contents]+combineSelectors hsl a b = do     a' <- a     b' <- b-    return $ a' ++ ContentRaw " " : b'+    return $ a' ++ addSpace b'+  where+    addSpace+        | hsl = (ContentRaw " " :)+        | otherwise = id  blockRuntime :: [(Deref, CDData url)]              -> (url -> [(Text, Text)] -> Text)@@ -211,12 +220,12 @@     resolveAttr (Attr k v) = Attr <$> (mconcat <$> mapM go' k) <*> (mconcat <$> mapM go' v)      subGo :: [Contents] -- ^ parent selectors-          -> Block Unresolved+          -> (HasLeadingSpace, Block Unresolved)           -> Either String (DList (Block Resolved))-    subGo x' (Block a b c d) =+    subGo x' (hls, Block a b c d) =         blockRuntime cd render' (Block a' b c d)       where-        a' = combineSelectors x' a+        a' = combineSelectors hls x' a  contentToBuilderRT :: [(Deref, CDData url)]                    -> (url -> [(Text, Text)] -> Text)@@ -312,7 +321,7 @@ compressBlock :: Block Unresolved               -> Block Unresolved compressBlock (Block x y blocks mixins) =-    Block (map cc x) (map go y) (map compressBlock blocks) mixins+    Block (map cc x) (map go y) (map (second compressBlock) blocks) mixins   where     go (Attr k v) = Attr (cc k) (cc v)     cc [] = []@@ -364,10 +373,10 @@     go (Attr x y) = conE 'Attr         `appE` (contentsToBuilder r scope x)         `appE` (contentsToBuilder r scope y)-    subGo (Block sel' b c d) =+    subGo (hls, Block sel' b c d) =         blockToCss r scope $ Block sel'' b c d       where-        sel'' = combineSelectors sel sel'+        sel'' = combineSelectors hls sel sel'  selectorToBuilder :: Name -> Scope -> [Contents] -> Q Exp selectorToBuilder r scope sels =

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-}@@ -88,7 +89,20 @@     pairsBlocks <- parsePairsBlocks id     let (pairs, blocks, mixins) = partitionPBs pairsBlocks     whiteSpace-    return $ Block sel pairs blocks mixins+    return $ Block sel pairs (map detectAmp blocks) mixins++-- | Looks for an & at the beginning of a selector and, if present, indicates+-- that we should not have a leading space. Otherwise, we should have the+-- leading space.+detectAmp :: Block Unresolved -> (Bool, Block Unresolved)+detectAmp (Block (sel) b c d) =+    (hls, Block sel' b c d)+  where+    (hls, sel') =+        case sel of+            (ContentRaw "&":rest):others -> (False, rest : others)+            (ContentRaw ('&':s):rest):others -> (False, (ContentRaw s : rest) : others)+            _ -> (True, sel)  partitionPBs :: [PairBlock] -> ([Attr Unresolved], [Block Unresolved], [Deref]) partitionPBs =

@@ -1,5 +1,5 @@ name:            shakespeare-css-version:         1.0.4+version:         1.0.5 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>

@@ -429,6 +429,15 @@                     }
                 |]
 
+    it "& subblocks" $
+        celper "foo:bar{baz:bin}"
+        [lucius|
+            foo {
+                &:bar {
+                    baz: bin;
+                }
+            }
+        |]
 
 data Url = Home | Sub SubUrl
 data SubUrl = SubUrl