css-text-0.1.1/0000755000000000000000000000000011664743727011472 5ustar0000000000000000css-text-0.1.1/css-text.cabal0000644000000000000000000000224711664743727014235 0ustar0000000000000000name: css-text version: 0.1.1 license: BSD3 license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman 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 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 , HUnit >= 1.2 , hspec >= 0.6.1 , QuickCheck source-repository head type: git location: git://github.com/yesodweb/css-text.git css-text-0.1.1/Setup.lhs0000644000000000000000000000016211664743727013301 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain css-text-0.1.1/runtests.hs0000644000000000000000000000507311664743727013722 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Text.CSS.Parse import Text.CSS.Render import Test.Hspec.Monadic import Test.Hspec.HUnit () import Test.Hspec.QuickCheck import Test.HUnit ((@=?)) 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 ((***)) main = hspecX $ do describe "single attribute parser" $ do it "trimming whitespace" $ Right ("foo", "bar") @=? parseAttr " foo : bar " describe "multiple attribute parser" $ do it "no final semicolon" $ Right [("foo", "bar"), ("baz", "bin")] @=? parseAttrs " foo: bar ; baz : bin " it "final semicolon" $ Right [("foo", "bar"), ("baz", "bin")] @=? parseAttrs " foo: bar ; baz : bin ;" it "ignores comments" $ Right [("foo", "bar"), ("baz", "bin")] @=? parseAttrs " foo: bar ; /* ignored */ baz : bin ;" describe "block parser" $ do it "multiple blocks" $ Right [ ("foo", [("fooK1", "fooV1"), ("fooK2", "fooV2")]) , ("bar", [("barK1", "barV1"), ("barK2", "barV2")]) ] @=? parseBlocks (T.concat [ "foo{fooK1:fooV1;/*ignored*/fooK2:fooV2 }\n\n" , "/*ignored*/" , "bar{barK1:barV1;/*ignored*/barK2:barV2 ;}\n\n/*ignored*/" ]) describe "render" $ do it "works" $ "foo{bar:baz;bin:bang}foo2{x:y}" @=? renderBlocks [ ("foo", [("bar", "baz"), ("bin", "bang")]) , ("foo2", [("x", "y")]) ] describe "parse/render" $ do prop "is idempotent" $ \bs -> parseBlocks (toStrict $ toLazyText $ renderBlocks $ unBlocks bs) == Right (unBlocks bs) newtype Blocks = Blocks { unBlocks :: [(Text, [(Text, Text)])] } deriving (Show, Eq) 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.1/LICENSE0000644000000000000000000000253011664743727012477 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.1/Text/0000755000000000000000000000000011664743727012416 5ustar0000000000000000css-text-0.1.1/Text/CSS/0000755000000000000000000000000011664743727013046 5ustar0000000000000000css-text-0.1.1/Text/CSS/Parse.hs0000644000000000000000000000345211664743727014460 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Text.CSS.Parse ( attrParser , attrsParser , blockParser , blocksParser , parseAttr , parseAttrs , parseBlock , parseBlocks ) where import Prelude hiding (takeWhile) import Data.Attoparsec.Text import Data.Text (Text, strip) import Control.Applicative ((<|>), many) import Data.Char (isSpace) parseAttrs :: Text -> Either String [(Text, Text)] parseAttrs = parseOnly attrsParser parseAttr :: Text -> Either String (Text, Text) parseAttr = parseOnly attrParser parseBlocks :: Text -> Either String [(Text, [(Text, Text)])] parseBlocks = parseOnly blocksParser parseBlock :: Text -> Either String (Text, [(Text, Text)]) parseBlock = parseOnly blockParser 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 (not . flip elem ":{}") _ <- char ':' <|> fail "Missing colon in attribute" value <- (takeWhile (not . flip elem ";}")) return (strip key, strip value) attrsParser :: Parser [(Text, Text)] attrsParser = go id where go front = (do a <- attrParser (char ';' >> return ()) <|> return () skipWS go $ front . (:) a ) <|> return (front []) blockParser :: Parser (Text, [(Text, Text)]) blockParser = do skipWS sel <- takeWhile (/= '{') _ <- char '{' attrs <- attrsParser skipWS _ <- char '}' return (strip sel, attrs) blocksParser :: Parser [(Text, [(Text, Text)])] blocksParser = many blockParser css-text-0.1.1/Text/CSS/Render.hs0000644000000000000000000000150611664743727014623 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Text.CSS.Render ( renderAttr , renderAttrs , renderBlock , renderBlocks ) where import Data.Text (Text) import Data.Text.Lazy.Builder (Builder, fromText, singleton) import Data.Monoid (mappend, mempty, mconcat) (<>) :: 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