packages feed

shakespeare-css 1.0.1.5 → 1.0.2

raw patch · 7 files changed

+356/−272 lines, 7 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

- Text.Cassius: instance Eq AbsoluteSize
- Text.Cassius: instance Eq AbsoluteUnit
- Text.Cassius: instance Eq EmSize
- Text.Cassius: instance Eq ExSize
- Text.Cassius: instance Eq PercentageSize
- Text.Cassius: instance Eq PixelSize
- Text.Cassius: instance Fractional AbsoluteSize
- Text.Cassius: instance Fractional EmSize
- Text.Cassius: instance Fractional ExSize
- Text.Cassius: instance Fractional PercentageSize
- Text.Cassius: instance Fractional PixelSize
- Text.Cassius: instance Num AbsoluteSize
- Text.Cassius: instance Num EmSize
- Text.Cassius: instance Num ExSize
- Text.Cassius: instance Num PercentageSize
- Text.Cassius: instance Num PixelSize
- Text.Cassius: instance Ord AbsoluteSize
- Text.Cassius: instance Ord EmSize
- Text.Cassius: instance Ord ExSize
- Text.Cassius: instance Ord PercentageSize
- Text.Cassius: instance Ord PixelSize
- Text.Cassius: instance Show AbsoluteSize
- Text.Cassius: instance Show AbsoluteUnit
- Text.Cassius: instance Show Color
- Text.Cassius: instance Show EmSize
- Text.Cassius: instance Show ExSize
- Text.Cassius: instance Show PercentageSize
- Text.Cassius: instance Show PixelSize
- Text.Cassius: instance ToCss AbsoluteSize
- Text.Cassius: instance ToCss Color
- Text.Cassius: instance ToCss EmSize
- Text.Cassius: instance ToCss ExSize
- Text.Cassius: instance ToCss PercentageSize
- Text.Cassius: instance ToCss PixelSize
+ Text.Cassius: cassiusUsedIdentifiers :: String -> [(Deref, VarType)]
+ Text.Lucius: AbsoluteSize :: AbsoluteUnit -> Rational -> AbsoluteSize
+ Text.Lucius: Centimeter :: AbsoluteUnit
+ Text.Lucius: Color :: Word8 -> Word8 -> Word8 -> Color
+ Text.Lucius: EmSize :: Rational -> EmSize
+ Text.Lucius: ExSize :: Rational -> ExSize
+ Text.Lucius: Inch :: AbsoluteUnit
+ Text.Lucius: Millimeter :: AbsoluteUnit
+ Text.Lucius: PercentageSize :: Rational -> PercentageSize
+ Text.Lucius: Pica :: AbsoluteUnit
+ Text.Lucius: PixelSize :: Rational -> PixelSize
+ Text.Lucius: Point :: AbsoluteUnit
+ Text.Lucius: absoluteSize :: AbsoluteUnit -> Rational -> AbsoluteSize
+ Text.Lucius: absoluteSizeUnit :: AbsoluteSize -> AbsoluteUnit
+ Text.Lucius: absoluteSizeValue :: AbsoluteSize -> Rational
+ Text.Lucius: class ToCss a
+ Text.Lucius: colorBlack :: Color
+ Text.Lucius: colorRed :: Color
+ Text.Lucius: data AbsoluteSize
+ Text.Lucius: data AbsoluteUnit
+ Text.Lucius: data Color
+ Text.Lucius: data Css
+ Text.Lucius: data EmSize
+ Text.Lucius: data ExSize
+ Text.Lucius: data PercentageSize
+ Text.Lucius: data PixelSize
+ Text.Lucius: luciusUsedIdentifiers :: String -> [(Deref, VarType)]
+ Text.Lucius: mkSize :: String -> ExpQ
+ Text.Lucius: parseTopLevels :: Parser [TopLevel]
+ Text.Lucius: percentageSize :: Rational -> PercentageSize
+ Text.Lucius: percentageSizeValue :: PercentageSize -> Rational
+ Text.Lucius: renderCss :: Css -> Text
+ Text.Lucius: renderCssUrl :: (url -> [(Text, Text)] -> Text) -> CssUrl url -> Text
+ Text.Lucius: toCss :: ToCss a => a -> Builder
+ Text.Lucius: type CssUrl url = (url -> [(Text, Text)] -> Text) -> Css

Files

Text/Cassius.hs view
@@ -32,144 +32,22 @@     , PercentageSize (..)     , percentageSize     , PixelSize (..)+      -- * Internal+    , cassiusUsedIdentifiers     ) where  import Text.Css-import Text.MkSizeType import Text.Shakespeare.Base-import Text.ParserCombinators.Parsec hiding (Line)-import Text.Printf (printf) import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH.Syntax-import Language.Haskell.TH-import Data.Text.Lazy.Builder (fromLazyText)-import Data.Maybe (catMaybes)-import Data.Word (Word8)-import Data.Bits-import qualified Data.Text as TS import qualified Data.Text.Lazy as TL-import Data.Char (isSpace)--data Color = Color Word8 Word8 Word8-    deriving Show-instance ToCss Color where-    toCss (Color r g b) =-        let (r1, r2) = toHex r-            (g1, g2) = toHex g-            (b1, b2) = toHex b-         in fromText $ TS.pack $ '#' :-            if r1 == r2 && g1 == g2 && b1 == b2-                then [r1, g1, b1]-                else [r1, r2, g1, g2, b1, b2]-      where-        toHex :: Word8 -> (Char, Char)-        toHex x = (toChar $ shiftR x 4, toChar $ x .&. 15)-        toChar :: Word8 -> Char-        toChar c-            | c < 10 = mkChar c 0 '0'-            | otherwise = mkChar c 10 'A'-        mkChar :: Word8 -> Word8 -> Char -> Char-        mkChar a b' c =-            toEnum $ fromIntegral $ a - b' + fromIntegral (fromEnum c)--colorRed :: Color-colorRed = Color 255 0 0--colorBlack :: Color-colorBlack = Color 0 0 0--renderCssUrl :: (url -> [(TS.Text, TS.Text)] -> TS.Text) -> CssUrl url -> TL.Text-renderCssUrl r s = renderCss $ s r--type CssUrl url = (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Css--parseBlocks :: Parser [Block]-parseBlocks = (map compressBlock . catMaybes) `fmap` many parseBlock--parseEmptyLine :: Parser ()-parseEmptyLine = do-    try $ skipMany $ oneOf " \t"-    parseComment <|> eol--parseComment :: Parser ()-parseComment = do-    _ <- try (skipMany (oneOf " \t") >> string "/*")-    _ <- manyTill anyChar $ try $ string "*/"-    -- FIXME This requires that any line beginning with a comment is entirely a comment-    skipMany $ oneOf " \t"-    _ <- eol <|> eof-    return ()--parseIndent :: Parser Int-parseIndent =-    sum `fmap` many ((char ' ' >> return 1) <|> (char '\t' >> fail "Tabs are not allowed in Cassius indentation"))--parseBlock :: Parser (Maybe Block)-parseBlock = do-    indent <- parseIndent-    (emptyBlock >> return Nothing)-        <|> (eof >> if indent > 0 then return Nothing else fail "")-        <|> realBlock indent-  where-    emptyBlock = parseEmptyLine-    realBlock indent = do-        name <- many1 $ parseContent True-        eol-        pairs <- fmap catMaybes $ many $ parsePair' indent-        case pairs of-            [] -> return Nothing-            _ -> return $ Just $ Block [name] pairs []-    parsePair' indent = try (parseEmptyLine >> return Nothing)-                    <|> try (Just `fmap` parsePair indent)--parsePair :: Int -> Parser (Contents, Contents)-parsePair minIndent = do-    indent <- parseIndent-    if indent <= minIndent then fail "not indented" else return ()-    key <- manyTill (parseContent False) $ char ':'-    spaces-    value <- manyTill (parseContent True) $ eol <|> eof-    return (trim key, value) -- FIXME consider trimming value as well--trim :: Contents -> Contents-trim =-    reverse . go . reverse . go-  where-    go [] = []-    go (ContentRaw x:xs) =-        case dropWhile isSpace x of-            [] -> go xs-            y -> ContentRaw y:xs-    go x = x---eol :: Parser ()-eol = (char '\n' >> return ()) <|> (string "\r\n" >> return ())--parseContent :: Bool -> Parser Content-parseContent allowColon =-    parseHash' <|> parseAt' <|> parseComment' <|> parseChar-  where-    parseHash' = either ContentRaw ContentVar `fmap` parseHash-    parseAt' =-        either ContentRaw go `fmap` parseAt-      where-        go (d, False) = ContentUrl d-        go (d, True) = ContentUrlParam d-    parseChar = (ContentRaw . return) `fmap` noneOf restricted-    restricted = (if allowColon then id else (:) ':') "\r\n"-    parseComment' = do-        _ <- try $ string "/*"-        _ <- manyTill anyChar $ try $ string "*/"-        return $ ContentRaw ""+import Text.CssCommon+import Text.Lucius (lucius)+import qualified Text.Lucius+import Text.IndentToBrace (i2b)  cassius :: QuasiQuoter-cassius = QuasiQuoter { quoteExp = cassiusFromString }--cassiusFromString :: String -> Q Exp-cassiusFromString s =-    topLevelsToCassius $ map TopBlock-  $ either (error . show) id $ parse parseBlocks s s+cassius = QuasiQuoter { quoteExp = quoteExp lucius . i2b }  cassiusFile :: FilePath -> Q Exp cassiusFile fp = do@@ -177,128 +55,13 @@     qAddDependentFile fp #endif     contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp-    cassiusFromString contents+    quoteExp cassius contents  cassiusFileDebug, cassiusFileReload :: FilePath -> Q Exp-cassiusFileDebug = cssFileDebug [|parseTopLevels|] parseTopLevels+cassiusFileDebug = cssFileDebug True [|Text.Lucius.parseTopLevels|] Text.Lucius.parseTopLevels cassiusFileReload = cassiusFileDebug -parseTopLevels :: Parser [TopLevel]-parseTopLevels = do-    x <- parseBlocks-    return $ map TopBlock x---- CSS size wrappers---- | Create a CSS size, e.g. $(mkSize "100px").-mkSize :: String -> ExpQ-mkSize s = appE nameE valueE-  where [(value, unit)] = reads s :: [(Double, String)]-        absoluteSizeE = varE $ mkName "absoluteSize"-        nameE = case unit of-          "cm" -> appE absoluteSizeE (conE $ mkName "Centimeter")-          "em" -> conE $ mkName "EmSize"-          "ex" -> conE $ mkName "ExSize"-          "in" -> appE absoluteSizeE (conE $ mkName "Inch")-          "mm" -> appE absoluteSizeE (conE $ mkName "Millimeter")-          "pc" -> appE absoluteSizeE (conE $ mkName "Pica")-          "pt" -> appE absoluteSizeE (conE $ mkName "Point")-          "px" -> conE $ mkName "PixelSize"-          "%" -> varE $ mkName "percentageSize"-          _ -> error $ "In mkSize, invalid unit: " ++ unit-        valueE = litE $ rationalL (toRational value)---- | Absolute size units.-data AbsoluteUnit = Centimeter-                  | Inch-                  | Millimeter-                  | Pica-                  | Point-                  deriving (Eq, Show)---- | Not intended for direct use, see 'mkSize'.-data AbsoluteSize = AbsoluteSize-    { absoluteSizeUnit :: AbsoluteUnit -- ^ Units used for text formatting.-    , absoluteSizeValue :: Rational -- ^ Normalized value in centimeters.-    }---- | Absolute size unit convertion rate to centimeters.-absoluteUnitRate :: AbsoluteUnit -> Rational-absoluteUnitRate Centimeter = 1-absoluteUnitRate Inch = 2.54-absoluteUnitRate Millimeter = 0.1-absoluteUnitRate Pica = 12 * absoluteUnitRate Point-absoluteUnitRate Point = 1 / 72 * absoluteUnitRate Inch---- | Constructs 'AbsoluteSize'. Not intended for direct use, see 'mkSize'.-absoluteSize :: AbsoluteUnit -> Rational -> AbsoluteSize-absoluteSize unit value = AbsoluteSize unit (value * absoluteUnitRate unit)--instance Show AbsoluteSize where-  show (AbsoluteSize unit value') = printf "%f" value ++ suffix-    where value = fromRational (value' / absoluteUnitRate unit) :: Double-          suffix = case unit of-            Centimeter -> "cm"-            Inch -> "in"-            Millimeter -> "mm"-            Pica -> "pc"-            Point -> "pt"--instance Eq AbsoluteSize where-  (AbsoluteSize _ v1) == (AbsoluteSize _ v2) = v1 == v2--instance Ord AbsoluteSize where-  compare (AbsoluteSize _ v1) (AbsoluteSize _ v2) = compare v1 v2--instance Num AbsoluteSize where-  (AbsoluteSize u1 v1) + (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 + v2)-  (AbsoluteSize u1 v1) * (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 * v2)-  (AbsoluteSize u1 v1) - (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 - v2)-  abs (AbsoluteSize u v) = AbsoluteSize u (abs v)-  signum (AbsoluteSize u v) = AbsoluteSize u (abs v)-  fromInteger x = AbsoluteSize Centimeter (fromInteger x)--instance Fractional AbsoluteSize where-  (AbsoluteSize u1 v1) / (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 / v2)-  fromRational x = AbsoluteSize Centimeter (fromRational x)--instance ToCss AbsoluteSize where-  toCss = fromText . TS.pack . show---- | Not intended for direct use, see 'mkSize'.-data PercentageSize = PercentageSize-    { percentageSizeValue :: Rational -- ^ Normalized value, 1 == 100%.-    }-                    deriving (Eq, Ord)---- | Constructs 'PercentageSize'. Not intended for direct use, see 'mkSize'.-percentageSize :: Rational -> PercentageSize-percentageSize value = PercentageSize (value / 100)--instance Show PercentageSize where-  show (PercentageSize value') = printf "%f" value ++ "%"-    where value = fromRational (value' * 100) :: Double--instance Num PercentageSize where-  (PercentageSize v1) + (PercentageSize v2) = PercentageSize (v1 + v2)-  (PercentageSize v1) * (PercentageSize v2) = PercentageSize (v1 * v2)-  (PercentageSize v1) - (PercentageSize v2) = PercentageSize (v1 - v2)-  abs (PercentageSize v) = PercentageSize (abs v)-  signum (PercentageSize v) = PercentageSize (abs v)-  fromInteger x = PercentageSize (fromInteger x)--instance Fractional PercentageSize where-  (PercentageSize v1) / (PercentageSize v2) = PercentageSize (v1 / v2)-  fromRational x = PercentageSize (fromRational x)--instance ToCss PercentageSize where-  toCss = fromText . TS.pack . show---- | Converts number and unit suffix to CSS format.-showSize :: Rational -> String -> String-showSize value' unit = printf "%f" value ++ unit-  where value = fromRational value' :: Double--mkSizeType "EmSize" "em"-mkSizeType "ExSize" "ex"-mkSizeType "PixelSize" "px"+-- | Determine which identifiers are used by the given template, useful for+-- creating systems like yesod devel.+cassiusUsedIdentifiers :: String -> [(Deref, VarType)]+cassiusUsedIdentifiers = cssUsedIdentifiers True Text.Lucius.parseTopLevels
Text/Css.hs view
@@ -19,7 +19,11 @@ import Language.Haskell.TH import Control.Applicative ((<$>), (<*>)) import Control.Arrow ((***))+import Text.IndentToBrace (i2b)+import Data.Functor.Identity (runIdentity) +type CssUrl url = (url -> [(T.Text, T.Text)] -> T.Text) -> Css+ pack :: String -> Text pack = T.pack #if !MIN_VERSION_text(0, 11, 2)@@ -62,20 +66,19 @@                 | CDUrl url                 | CDUrlParam (url, [(Text, Text)]) -cssFileDebug :: Q Exp -> Parser [TopLevel] -> FilePath -> Q Exp-cssFileDebug parseBlocks' parseBlocks fp = do-    s <- fmap TL.unpack $ qRunIO $ readUtf8File fp-#ifdef GHC_7_4-    qAddDependentFile fp-#endif-    let a = either (error . show) id $ parse parseBlocks s s-    let (scope, contents) = go a-    vs <- mapM (getVars scope) contents-    c <- mapM vtToExp $ concat vs-    cr <- [|cssRuntime|]-    parseBlocks'' <- parseBlocks'-    return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c+-- | 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]+                   -> String+                   -> [(Deref, VarType)]+cssUsedIdentifiers toi2b parseBlocks s' =+    concat $ runIdentity $ mapM (getVars scope0) contents   where+    s = if toi2b then i2b s' else s'+    a = either (error . show) id $ parse parseBlocks s s+    (scope0, contents) = go a+     go :: [TopLevel] -> ([(String, String)], [Content])     go [] = ([], [])     go (TopAtDecl dec _FIXMEcs:rest) =@@ -105,6 +108,19 @@         (scope, rest') = go rest     go' (k, v) = k ++ v +cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion+             -> Q Exp -> Parser [TopLevel] -> FilePath -> Q Exp+cssFileDebug toi2b parseBlocks' parseBlocks fp = do+    s <- fmap TL.unpack $ qRunIO $ readUtf8File fp+#ifdef GHC_7_4+    qAddDependentFile fp+#endif+    let vs = cssUsedIdentifiers toi2b parseBlocks s+    c <- mapM vtToExp vs+    cr <- [|cssRuntime toi2b|]+    parseBlocks'' <- parseBlocks'+    return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c+ combineSelectors :: Selector -> Selector -> Selector combineSelectors a b = do     a' <- a@@ -156,13 +172,15 @@             Right $ fromText $ render' u p         _ -> Left $ show d ++ ": expected CDUrlParam" -cssRuntime :: Parser [TopLevel]+cssRuntime :: Bool -- ^ i2b?+           -> Parser [TopLevel]            -> FilePath            -> [(Deref, CDData url)]            -> (url -> [(Text, Text)] -> Text)            -> Css-cssRuntime parseBlocks fp cd render' = unsafePerformIO $ do-    s <- fmap TL.unpack $ qRunIO $ readUtf8File fp+cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do+    s' <- fmap TL.unpack $ qRunIO $ readUtf8File fp+    let s = if toi2b then i2b s' else s'     let a = either (error . show) id $ parse parseBlocks s s     return $ CssWhitespace $ goTop [] a   where
+ Text/CssCommon.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}+module Text.CssCommon where++import Text.Css+import Text.MkSizeType+import qualified Data.Text as TS+import Text.Printf (printf)+import Language.Haskell.TH+import Data.Word (Word8)+import Data.Bits+import Data.Text.Lazy.Builder (fromLazyText)+import qualified Data.Text.Lazy as TL++renderCssUrl :: (url -> [(TS.Text, TS.Text)] -> TS.Text) -> CssUrl url -> TL.Text+renderCssUrl r s = renderCss $ s r++data Color = Color Word8 Word8 Word8+    deriving Show+instance ToCss Color where+    toCss (Color r g b) =+        let (r1, r2) = toHex r+            (g1, g2) = toHex g+            (b1, b2) = toHex b+         in fromText $ TS.pack $ '#' :+            if r1 == r2 && g1 == g2 && b1 == b2+                then [r1, g1, b1]+                else [r1, r2, g1, g2, b1, b2]+      where+        toHex :: Word8 -> (Char, Char)+        toHex x = (toChar $ shiftR x 4, toChar $ x .&. 15)+        toChar :: Word8 -> Char+        toChar c+            | c < 10 = mkChar c 0 '0'+            | otherwise = mkChar c 10 'A'+        mkChar :: Word8 -> Word8 -> Char -> Char+        mkChar a b' c =+            toEnum $ fromIntegral $ a - b' + fromIntegral (fromEnum c)++colorRed :: Color+colorRed = Color 255 0 0++colorBlack :: Color+colorBlack = Color 0 0 0++-- CSS size wrappers++-- | Create a CSS size, e.g. $(mkSize "100px").+mkSize :: String -> ExpQ+mkSize s = appE nameE valueE+  where [(value, unit)] = reads s :: [(Double, String)]+        absoluteSizeE = varE $ mkName "absoluteSize"+        nameE = case unit of+          "cm" -> appE absoluteSizeE (conE $ mkName "Centimeter")+          "em" -> conE $ mkName "EmSize"+          "ex" -> conE $ mkName "ExSize"+          "in" -> appE absoluteSizeE (conE $ mkName "Inch")+          "mm" -> appE absoluteSizeE (conE $ mkName "Millimeter")+          "pc" -> appE absoluteSizeE (conE $ mkName "Pica")+          "pt" -> appE absoluteSizeE (conE $ mkName "Point")+          "px" -> conE $ mkName "PixelSize"+          "%" -> varE $ mkName "percentageSize"+          _ -> error $ "In mkSize, invalid unit: " ++ unit+        valueE = litE $ rationalL (toRational value)++-- | Absolute size units.+data AbsoluteUnit = Centimeter+                  | Inch+                  | Millimeter+                  | Pica+                  | Point+                  deriving (Eq, Show)++-- | Not intended for direct use, see 'mkSize'.+data AbsoluteSize = AbsoluteSize+    { absoluteSizeUnit :: AbsoluteUnit -- ^ Units used for text formatting.+    , absoluteSizeValue :: Rational -- ^ Normalized value in centimeters.+    }++-- | Absolute size unit convertion rate to centimeters.+absoluteUnitRate :: AbsoluteUnit -> Rational+absoluteUnitRate Centimeter = 1+absoluteUnitRate Inch = 2.54+absoluteUnitRate Millimeter = 0.1+absoluteUnitRate Pica = 12 * absoluteUnitRate Point+absoluteUnitRate Point = 1 / 72 * absoluteUnitRate Inch++-- | Constructs 'AbsoluteSize'. Not intended for direct use, see 'mkSize'.+absoluteSize :: AbsoluteUnit -> Rational -> AbsoluteSize+absoluteSize unit value = AbsoluteSize unit (value * absoluteUnitRate unit)++instance Show AbsoluteSize where+  show (AbsoluteSize unit value') = printf "%f" value ++ suffix+    where value = fromRational (value' / absoluteUnitRate unit) :: Double+          suffix = case unit of+            Centimeter -> "cm"+            Inch -> "in"+            Millimeter -> "mm"+            Pica -> "pc"+            Point -> "pt"++instance Eq AbsoluteSize where+  (AbsoluteSize _ v1) == (AbsoluteSize _ v2) = v1 == v2++instance Ord AbsoluteSize where+  compare (AbsoluteSize _ v1) (AbsoluteSize _ v2) = compare v1 v2++instance Num AbsoluteSize where+  (AbsoluteSize u1 v1) + (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 + v2)+  (AbsoluteSize u1 v1) * (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 * v2)+  (AbsoluteSize u1 v1) - (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 - v2)+  abs (AbsoluteSize u v) = AbsoluteSize u (abs v)+  signum (AbsoluteSize u v) = AbsoluteSize u (abs v)+  fromInteger x = AbsoluteSize Centimeter (fromInteger x)++instance Fractional AbsoluteSize where+  (AbsoluteSize u1 v1) / (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 / v2)+  fromRational x = AbsoluteSize Centimeter (fromRational x)++instance ToCss AbsoluteSize where+  toCss = fromText . TS.pack . show++-- | Not intended for direct use, see 'mkSize'.+data PercentageSize = PercentageSize+    { percentageSizeValue :: Rational -- ^ Normalized value, 1 == 100%.+    }+                    deriving (Eq, Ord)++-- | Constructs 'PercentageSize'. Not intended for direct use, see 'mkSize'.+percentageSize :: Rational -> PercentageSize+percentageSize value = PercentageSize (value / 100)++instance Show PercentageSize where+  show (PercentageSize value') = printf "%f" value ++ "%"+    where value = fromRational (value' * 100) :: Double++instance Num PercentageSize where+  (PercentageSize v1) + (PercentageSize v2) = PercentageSize (v1 + v2)+  (PercentageSize v1) * (PercentageSize v2) = PercentageSize (v1 * v2)+  (PercentageSize v1) - (PercentageSize v2) = PercentageSize (v1 - v2)+  abs (PercentageSize v) = PercentageSize (abs v)+  signum (PercentageSize v) = PercentageSize (abs v)+  fromInteger x = PercentageSize (fromInteger x)++instance Fractional PercentageSize where+  (PercentageSize v1) / (PercentageSize v2) = PercentageSize (v1 / v2)+  fromRational x = PercentageSize (fromRational x)++instance ToCss PercentageSize where+  toCss = fromText . TS.pack . show++-- | Converts number and unit suffix to CSS format.+showSize :: Rational -> String -> String+showSize value' unit = printf "%f" value ++ unit+  where value = fromRational value' :: Double++mkSizeType "EmSize" "em"+mkSizeType "ExSize" "ex"+mkSizeType "PixelSize" "px"
+ Text/IndentToBrace.hs view
@@ -0,0 +1,83 @@+module Text.IndentToBrace+    ( i2b+    ) where++import Control.Monad.Trans.Writer (execWriter, tell, Writer)+import Data.List (isPrefixOf, isInfixOf)++i2b :: String -> String+i2b = ($ [])+    . execWriter+    . mapM_ unnest+    . map addClosingCount+    . nest+    . map toL+    . lines+    . filter (/= '\r')++data Line = Line+    { lineIndent  :: Int+    , lineContent :: String+    }+    deriving (Show, Eq)++data Nest = Nest Line Int [Nest]+          | Blank String+    deriving (Show, Eq)++isBlank :: Nest -> Bool+isBlank Blank{} = True+isBlank _ = False++addClosingCount :: Nest -> Nest+addClosingCount (Blank x) = Blank x+addClosingCount (Nest l c children) =+    Nest l c $ increment $ map addClosingCount children+  where+    increment+        | any (not . isBlank) children = increment'+        | otherwise = id++    increment' [] = error "should never happen"+    increment' (Blank x:rest) = Blank x : increment' rest+    increment' (n@(Nest l' c' children'):rest)+        | any (not . isBlank) rest = n : increment' rest+        | any (not . isBlank) children' = Nest l' c' (increment' children') : rest+        | otherwise = Nest l' (c' + 1) children' : rest++toL :: String -> Either String Line+toL s+    | null y || "/*" `isPrefixOf` y = Left s+    | otherwise = Right $ Line (length x) y+  where+    (x, y) = span (== ' ') s++nest :: [Either String Line] -> [Nest]+nest [] = []+nest (Left x:rest) = Blank x : nest rest+nest (Right l:rest) =+    Nest l 0 (nest inside) : nest outside+  where+    (inside, outside) = span isNested rest+    isNested Left{} = True+    isNested (Right l2) = lineIndent l2 > lineIndent l++tell' :: String -> Writer (String -> String) ()+tell' s = tell (s ++)++unnest :: Nest -> Writer (String -> String) ()+unnest (Blank x) = do+    tell' x+    tell' "\n"+unnest (Nest l count inside) = do+    tell' $ replicate (lineIndent l) ' '+    tell' $ lineContent l+    tell' $+        case () of+            ()+                | not $ all isBlank inside -> "{"+                | ";" `isInfixOf` lineContent l -> ""+                | otherwise -> ";"+    tell' $ replicate count '}'+    tell' "\n"+    mapM_ unnest inside
Text/Lucius.hs view
@@ -13,11 +13,35 @@       -- ** Runtime     , luciusRT     , luciusRT'-      -- * Re-export cassius-    , module Text.Cassius+    , -- * Datatypes+      Css+    , CssUrl+      -- * Type class+    , ToCss (..)+      -- * Rendering+    , renderCss+    , renderCssUrl+      -- * ToCss instances+      -- ** Color+    , Color (..)+    , colorRed+    , colorBlack+      -- ** Size+    , mkSize+    , AbsoluteUnit (..)+    , AbsoluteSize (..)+    , absoluteSize+    , EmSize (..)+    , ExSize (..)+    , PercentageSize (..)+    , percentageSize+    , PixelSize (..)+      -- * Internal+    , parseTopLevels+    , luciusUsedIdentifiers     ) where -import Text.Cassius hiding (cassius, cassiusFile, cassiusFileDebug, cassiusFileReload)+import Text.CssCommon import Text.Shakespeare.Base import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH.Syntax@@ -161,7 +185,7 @@     luciusFromString contents  luciusFileDebug, luciusFileReload :: FilePath -> Q Exp-luciusFileDebug = cssFileDebug [|parseTopLevels|] parseTopLevels+luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels luciusFileReload = luciusFileDebug  parseTopLevels :: Parser [TopLevel]@@ -262,3 +286,8 @@  luciusRT :: TL.Text -> [(Text, Text)] -> Either String TL.Text luciusRT tl scope = either Left (Right . renderCss . CssWhitespace) $ either Left ($ scope) (luciusRT' tl)++-- | Determine which identifiers are used by the given template, useful for+-- creating systems like yesod devel.+luciusUsedIdentifiers :: String -> [(Deref, VarType)]+luciusUsedIdentifiers = cssUsedIdentifiers False parseTopLevels
shakespeare-css.cabal view
@@ -1,5 +1,5 @@ name:            shakespeare-css-version:         1.0.1.5+version:         1.0.2 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -35,11 +35,14 @@                    , text             >= 0.11.1.1 && < 0.12                    , process          >= 1.0      && < 1.2                    , parsec           >= 2        && < 4+                   , transformers      exposed-modules: Text.Cassius                      Text.Lucius     other-modules:   Text.MkSizeType                      Text.Css+                     Text.IndentToBrace+                     Text.CssCommon     ghc-options:     -Wall     if impl(ghc >= 7.4)        cpp-options: -DGHC_7_4
test/ShakespeareCssTest.hs view
@@ -91,15 +91,38 @@ 
 
     it "cassius trailing comments" $
-      celper "h1:hover {color:green ;font-family:sans-serif}" [cassius|
+      celper "h1:hover{color:green ;font-family:sans-serif}" [cassius|
     h1:hover /* Please ignore this */
         color: green /* This is a comment. */
         /* Obviously this is ignored too. */
         font-family:sans-serif
     |]
 
+    it "cassius nesting" $
+      celper "foo bar{baz:bin}" [cassius|
+    foo
+        bar
+            baz: bin
+    |]
 
+    it "cassius variable" $
+      celper "foo bar{baz:bin}" [cassius|
+    @binvar: bin
+    foo
+        bar
+            baz: #{binvar}
+    |]
 
+    it "cassius trailing semicolon" $
+      celper "foo bar{baz:bin}" [cassius|
+    @binvar: bin
+    foo
+        bar
+            baz: #{binvar};
+    |]
+
+
+
     it "cassius module names" $ do
       let foo = "foo"
           dub = 3.14::Double
@@ -118,10 +141,12 @@     att: $@^
 |]
 
+  {-
       celper "sel{att:#{@{^{}" [cassius|
 sel
     att: #\{@\{^{
 |]
+-}
 
 
     it "dollar operator" $ do
@@ -262,11 +287,13 @@         |]
 
 
+    {-
     it "cassius removes whitespace" $ do
       celper "foo{bar:baz}" [cassius|
       foo
           bar     :    baz
       |]
+      -}