css-text-0.1.3.0/src/0000755000000000000000000000000013236016540012400 5ustar0000000000000000css-text-0.1.3.0/src/Text/0000755000000000000000000000000012737472342013337 5ustar0000000000000000css-text-0.1.3.0/src/Text/CSS/0000755000000000000000000000000013236016073013755 5ustar0000000000000000css-text-0.1.3.0/test/0000755000000000000000000000000013236016524012572 5ustar0000000000000000css-text-0.1.3.0/src/Text/CSS/Parse.hs0000644000000000000000000000673012737472342015403 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.3.0/src/Text/CSS/Render.hs0000644000000000000000000000243013236016073015527 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 (mempty, mconcat) import Data.Semigroup ((<>)) import Text.CSS.Parse 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 css-text-0.1.3.0/test/runtests.hs0000644000000000000000000000717513236015773015034 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, when) 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 when False $ it "three levels of nesting" $ do let bs = [NestedBlock "a" [NestedBlock "b" [LeafBlock ("c",[])]]] txt = "a{b{c{}}}" parseNestedBlocks txt `shouldBe` Right bs prop "idempotent blocks" $ \bs -> parseBlocks (toStrict $ toLazyText $ renderBlocks $ unBlocks bs) == Right (unBlocks bs) when False $ prop "idempotent nested blocks" $ \bs -> parseNestedBlocks (toStrict $ toLazyText $ renderNestedBlocks bs) `shouldBe` Right bs newtype Blocks = Blocks { unBlocks :: [(Text, [(Text, Text)])] } deriving (Show, Eq) instance Arbitrary NestedBlock where arbitrary = frequency [ (80, (LeafBlock . unBlock) `liftM` arbitrary) , (10, do mediatype <- elements ["print", "screen", "(min-width:768px)"] contents <- arbitrary return (NestedBlock mediatype contents)) ] 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.3.0/LICENSE0000644000000000000000000000207512737472745012644 0ustar0000000000000000Copyright (c) 2010 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. css-text-0.1.3.0/Setup.lhs0000755000000000000000000000016212737472342013436 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain css-text-0.1.3.0/css-text.cabal0000644000000000000000000000306413236023626014355 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack -- -- hash: bc09a14475e42f4d9f29dd5063a9bde24ddcf078b0d4749b9a91275c3c82231b name: css-text version: 0.1.3.0 synopsis: CSS parser and renderer. description: Please see the README and generated docs at category: Web, Yesod stability: Stable homepage: https://github.com/yesodweb/css-text.git#readme bug-reports: https://github.com/yesodweb/css-text.git/issues author: Michael Snoyman maintainer: Michael Snoyman , Greg Weber license: MIT license-file: LICENSE build-type: Simple cabal-version: >= 1.10 extra-source-files: ChangeLog.md README.md source-repository head type: git location: https://github.com/yesodweb/css-text.git library hs-source-dirs: src ghc-options: -Wall build-depends: attoparsec >=0.10.2.0 , base >=4 && <5 , text >=0.11 if !(impl(ghc >=8.0)) build-depends: semigroups >=0.16.1 exposed-modules: Text.CSS.Parse Text.CSS.Render other-modules: Paths_css_text default-language: Haskell2010 test-suite runtests type: exitcode-stdio-1.0 main-is: runtests.hs hs-source-dirs: test build-depends: QuickCheck , attoparsec >=0.10.2.0 , base >=4 && <5 , css-text , hspec >=1.3 , text >=0.11 other-modules: Paths_css_text default-language: Haskell2010 css-text-0.1.3.0/ChangeLog.md0000644000000000000000000000017413236023610013760 0ustar0000000000000000## 0.1.3.0 * Support for GHC 8.4 [#13](https://github.com/yesodweb/css-text/pull/13) ## 0.1.2.2 * Clarified MIT license css-text-0.1.3.0/README.md0000644000000000000000000000050013236016212013057 0ustar0000000000000000# css-text [![Build Status](https://travis-ci.org/yesodweb/css-text.svg?branch=master)](https://travis-ci.org/yesodweb/css-text) [![Build status](https://ci.appveyor.com/api/projects/status/xss40qb97i2qspma/branch/master?svg=true)](https://ci.appveyor.com/project/snoyberg/css-text/branch/master) a haskell css parser