css-text-0.1.2.1/0000755000000000000000000000000012311353521011605 5ustar0000000000000000css-text-0.1.2.1/LICENSE0000644000000000000000000000253012311353521012612 0ustar0000000000000000The following license covers this documentation, and the source code, except where otherwise indicated. Copyright 2010, Michael Snoyman. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. css-text-0.1.2.1/runtests.hs0000644000000000000000000000631512311353521014035 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Text.CSS.Parse import Text.CSS.Render import Test.Hspec import Test.Hspec.QuickCheck (prop) import qualified Data.Text as T import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy (toStrict) import Data.Text (Text) import Test.QuickCheck import Control.Arrow ((***)) import Control.Monad (liftM) main :: IO () main = hspec $ do describe "single attribute parser" $ do it "trimming whitespace" $ parseAttr " foo : bar " `shouldBe` Right ("foo", "bar") describe "multiple attribute parser" $ do it "no final semicolon" $ parseAttrs " foo: bar ; baz : bin " `shouldBe` Right [("foo", "bar"), ("baz", "bin")] it "final semicolon" $ parseAttrs " foo: bar ; baz : bin ;" `shouldBe` Right [("foo", "bar"), ("baz", "bin")] it "ignores comments" $ parseAttrs " foo: bar ; /* ignored */ baz : bin ;" `shouldBe` Right [("foo", "bar"), ("baz", "bin")] describe "block parser" $ do it "multiple blocks" $ parseBlocks (T.concat [ "foo{fooK1:fooV1;/*ignored*/fooK2:fooV2 }\n\n" , "/*ignored*/" , "bar{barK1:barV1;/*ignored*/barK2:barV2 ;}\n\n/*ignored*/" ]) `shouldBe` Right [ ("foo", [("fooK1", "fooV1"), ("fooK2", "fooV2")]) , ("bar", [("barK1", "barV1"), ("barK2", "barV2")]) ] it "media queries" $ do parseBlocks "@media print {* {text-shadow: none !important;} }" `shouldBe` Right [] parseNestedBlocks "@media print {* {text-shadow: none !important; color: #000 !important; } a, a:visited { text-decoration: underline; }}" `shouldBe` Right [NestedBlock "@media print" [ LeafBlock ("*", [("text-shadow", "none !important"), ("color", "#000 !important")]) , LeafBlock ("a, a:visited", [("text-decoration", "underline")]) ] ] describe "render" $ -- do it "works" $ renderBlocks [ ("foo", [("bar", "baz"), ("bin", "bang")]) , ("foo2", [("x", "y")]) ] `shouldBe` "foo{bar:baz;bin:bang}foo2{x:y}" describe "parse/render" $ do prop "idempotent blocks" $ \bs -> parseBlocks (toStrict $ toLazyText $ renderBlocks $ unBlocks bs) == Right (unBlocks bs) prop "idempotent nested blocks" $ \bs -> parseNestedBlocks (toStrict $ toLazyText $ renderNestedBlocks bs) == Right bs newtype Blocks = Blocks { unBlocks :: [(Text, [(Text, Text)])] } deriving (Show, Eq) instance Arbitrary NestedBlock where arbitrary = (LeafBlock . unBlock) `liftM` arbitrary instance Arbitrary Blocks where arbitrary = fmap (Blocks . map unBlock) arbitrary newtype Block = Block { unBlock :: (Text, [(Text, Text)]) } deriving (Show, Eq) instance Arbitrary Block where arbitrary = do (sel, attrs) <- arbitrary return $ Block (unT sel, unAttrs attrs) newtype Attrs = Attrs { unAttrs :: [(Text, Text)] } instance Arbitrary Attrs where arbitrary = fmap (Attrs . map (unT *** unT)) arbitrary newtype T = T { unT :: Text } instance Arbitrary T where arbitrary = fmap (T . T.pack) $ listOf1 $ elements $ concat [ ['A'..'Z'] , ['a'..'z'] , ['0'..'9'] , "-_" ] css-text-0.1.2.1/css-text.cabal0000644000000000000000000000223312311353521014343 0ustar0000000000000000name: css-text version: 0.1.2.1 license: BSD3 license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman , Greg Weber synopsis: CSS parser and renderer. category: Web, Yesod stability: Stable cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/ extra-source-files: runtests.hs library build-depends: base >= 4 && < 5 , text >= 0.11 , attoparsec >= 0.10.2.0 exposed-modules: Text.CSS.Parse Text.CSS.Render ghc-options: -Wall test-suite runtests type: exitcode-stdio-1.0 main-is: runtests.hs build-depends: base >= 4 && < 5 , text >= 0.11 , attoparsec >= 0.10.2.0 , hspec >= 1.3 , QuickCheck source-repository head type: git location: git://github.com/yesodweb/css-text.git css-text-0.1.2.1/Setup.lhs0000644000000000000000000000016212311353521013414 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain css-text-0.1.2.1/Text/0000755000000000000000000000000012311353521012531 5ustar0000000000000000css-text-0.1.2.1/Text/CSS/0000755000000000000000000000000012311353521013161 5ustar0000000000000000css-text-0.1.2.1/Text/CSS/Parse.hs0000644000000000000000000000673012311353521014575 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Parse CSS with parseNestedBlocks and render it with renderNestedBlock module Text.CSS.Parse ( NestedBlock(..) , parseNestedBlocks , parseBlocks , parseBlock , attrParser , attrsParser , blockParser , blocksParser , parseAttr , parseAttrs ) where import Prelude hiding (takeWhile, take) import Data.Attoparsec.Text import Data.Text (Text, strip) import Control.Applicative ((<|>), many, (<$>)) import Data.Char (isSpace) type CssBlock = (Text, [(Text, Text)]) data NestedBlock = NestedBlock Text [NestedBlock] -- ^ for example a media query | LeafBlock CssBlock deriving (Eq, Show) -- | The preferred parser, will capture media queries parseNestedBlocks :: Text -> Either String [NestedBlock] parseNestedBlocks = parseOnly nestedBlocksParser -- | The original parser of basic CSS, but throws out media queries parseBlocks :: Text -> Either String [CssBlock] parseBlocks = parseOnly blocksParser parseBlock :: Text -> Either String CssBlock parseBlock = parseOnly blockParser parseAttrs :: Text -> Either String [(Text, Text)] parseAttrs = parseOnly attrsParser parseAttr :: Text -> Either String (Text, Text) parseAttr = parseOnly attrParser skipWS :: Parser () skipWS = (string "/*" >> endComment >> skipWS) <|> (skip isSpace >> skipWhile isSpace >> skipWS) <|> return () where endComment = do skipWhile (/= '*') (do _ <- char '*' (char '/' >> return ()) <|> endComment ) <|> fail "Missing end comment" attrParser :: Parser (Text, Text) attrParser = do skipWS key <- takeWhile1 (\c -> c /= ':' && c /= '{' && c /= '}') _ <- char ':' <|> fail "Missing colon in attribute" value <- valueParser return (strip key, strip value) valueParser :: Parser Text valueParser = takeWhile (\c -> c /= ';' && c /= '}') attrsParser :: Parser [(Text, Text)] attrsParser = (do a <- attrParser (char ';' >> skipWS >> ((a :) <$> attrsParser)) <|> return [a] ) <|> return [] blockParser :: Parser (Text, [(Text, Text)]) blockParser = do skipWS sel <- takeWhile (/= '{') _ <- char '{' attrs <- attrsParser skipWS _ <- char '}' return (strip sel, attrs) nestedBlockParser :: Parser NestedBlock nestedBlockParser = do skipWS sel <- strip <$> takeTill (== '{') _ <- char '{' skipWS unknown <- strip <$> takeTill (\c -> c == '{' || c == '}' || c == ':') mc <- peekChar res <- case mc of Nothing -> fail "unexpected end of input" Just c -> nestedParse sel unknown c skipWS _ <- char '}' return res where -- no colon means no content nestedParse sel _ '}' = return $ LeafBlock (sel, []) nestedParse sel unknown ':' = do _ <- char ':' value <- valueParser (char ';' >> return ()) <|> return () skipWS moreAttrs <- attrsParser return $ LeafBlock (sel, (unknown, strip value) : moreAttrs) -- TODO: handle infinite nesting nestedParse sel unknown '{' = do _ <- char '{' attrs <- attrsParser skipWS _ <- char '}' blocks <- blocksParser return $ NestedBlock sel $ map LeafBlock $ (unknown, attrs) : blocks nestedParse _ _ c = fail $ "expected { or : but got " ++ [c] blocksParser :: Parser [(Text, [(Text, Text)])] blocksParser = many blockParser nestedBlocksParser :: Parser [NestedBlock] nestedBlocksParser = many nestedBlockParser css-text-0.1.2.1/Text/CSS/Render.hs0000644000000000000000000000247212311353521014741 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Prender CSS with renderNestedBlocks module Text.CSS.Render ( renderNestedBlocks , renderBlocks , renderBlock , renderAttrs , renderAttr ) where import Data.Text (Text) import Data.Text.Lazy.Builder (Builder, fromText, singleton) import Data.Monoid (mappend, mempty, mconcat) import Text.CSS.Parse (<>) :: Builder -> Builder -> Builder (<>) = mappend renderAttr :: (Text, Text) -> Builder renderAttr (k, v) = fromText k <> singleton ':' <> fromText v renderAttrs :: [(Text, Text)] -> Builder renderAttrs [] = mempty renderAttrs [x] = renderAttr x renderAttrs (x:xs) = renderAttr x <> singleton ';' <> renderAttrs xs renderBlock :: (Text, [(Text, Text)]) -> Builder renderBlock (sel, attrs) = fromText sel <> singleton '{' <> renderAttrs attrs <> singleton '}' renderBlocks :: [(Text, [(Text, Text)])] -> Builder renderBlocks = mconcat . map renderBlock renderNestedBlock :: NestedBlock -> Builder renderNestedBlock (LeafBlock b) = renderBlock b renderNestedBlock (NestedBlock t bs) = fromText t <> singleton '{' <> renderNestedBlocks bs <> singleton '}' renderNestedBlocks :: [NestedBlock] -> Builder renderNestedBlocks = mconcat . map renderNestedBlock