1{-# LANGUAGE OverloadedStrings #-} 2import Text.CSS.Parse 3import Text.CSS.Render 4import Test.Hspec 5import Test.Hspec.QuickCheck (prop) 6import qualified Data.Text as T 7import Data.Text.Lazy.Builder (toLazyText) 8import Data.Text.Lazy (toStrict) 9import Data.Text (Text) 10import Test.QuickCheck 11import Control.Arrow ((***)) 12import Control.Monad (liftM, when) 13 14main :: IO () 15main = hspec $ do 16 describe "single attribute parser" $ do 17 it "trimming whitespace" $ 18 parseAttr " foo : bar " `shouldBe` Right ("foo", "bar") 19 20 describe "multiple attribute parser" $ do 21 it "no final semicolon" $ 22 parseAttrs " foo: bar ; baz : bin " 23 `shouldBe` Right [("foo", "bar"), ("baz", "bin")] 24 25 it "final semicolon" $ 26 parseAttrs " foo: bar ; baz : bin ;" 27 `shouldBe` Right [("foo", "bar"), ("baz", "bin")] 28 29 it "ignores comments" $ 30 parseAttrs " foo: bar ; /* ignored */ baz : bin ;" 31 `shouldBe` Right [("foo", "bar"), ("baz", "bin")] 32 33 describe "block parser" $ do 34 it "multiple blocks" $ 35 parseBlocks (T.concat 36 [ "foo{fooK1:fooV1;/*ignored*/fooK2:fooV2 }\n\n" 37 , "/*ignored*/" 38 , "bar{barK1:barV1;/*ignored*/barK2:barV2 ;}\n\n/*ignored*/" 39 ]) `shouldBe` Right [ 40 ("foo", [("fooK1", "fooV1"), ("fooK2", "fooV2")]) 41 , ("bar", [("barK1", "barV1"), ("barK2", "barV2")]) 42 ] 43 44 it "media queries" $ do 45 parseBlocks "@media print {* {text-shadow: none !important;} }" 46 `shouldBe` Right [] 47 parseNestedBlocks "@media print {* {text-shadow: none !important; color: #000 !important; } a, a:visited { text-decoration: underline; }}" 48 `shouldBe` Right [NestedBlock "@media print" 49 [ LeafBlock ("*", [("text-shadow", "none !important"), ("color", "#000 !important")]) 50 , LeafBlock ("a, a:visited", [("text-decoration", "underline")]) 51 ] 52 ] 53 54 describe "render" $ -- do 55 it "works" $ 56 renderBlocks [ 57 ("foo", [("bar", "baz"), ("bin", "bang")]) 58 , ("foo2", [("x", "y")]) 59 ] 60 `shouldBe` "foo{bar:baz;bin:bang}foo2{x:y}" 61 62 describe "parse/render" $ do 63 when False $ it "three levels of nesting" $ do 64 let bs = [NestedBlock "a" [NestedBlock "b" [LeafBlock ("c",[])]]] 65 txt = "a{b{c{}}}" 66 parseNestedBlocks txt `shouldBe` Right bs 67 prop "idempotent blocks" $ \bs -> 68 parseBlocks (toStrict $ toLazyText $ renderBlocks $ unBlocks bs) == Right (unBlocks bs) 69 when False $ prop "idempotent nested blocks" $ \bs -> 70 parseNestedBlocks (toStrict $ toLazyText $ renderNestedBlocks bs) `shouldBe` Right bs 71 72newtype Blocks = Blocks { unBlocks :: [(Text, [(Text, Text)])] } 73 deriving (Show, Eq) 74 75instance Arbitrary NestedBlock where 76 arbitrary = frequency 77 [ (80, (LeafBlock . unBlock) `liftM` arbitrary) 78 , (10, do mediatype <- elements ["print", "screen", "(min-width:768px)"] 79 contents <- arbitrary 80 return (NestedBlock mediatype contents)) 81 ] 82 83instance Arbitrary Blocks where 84 arbitrary = fmap (Blocks . map unBlock) arbitrary 85 86newtype Block = Block { unBlock :: (Text, [(Text, Text)]) } 87 deriving (Show, Eq) 88 89instance Arbitrary Block where 90 arbitrary = do 91 (sel, attrs) <- arbitrary 92 return $ Block (unT sel, unAttrs attrs) 93 94newtype Attrs = Attrs { unAttrs :: [(Text, Text)] } 95 96instance Arbitrary Attrs where 97 arbitrary = fmap (Attrs . map (unT *** unT)) arbitrary 98 99newtype T = T { unT :: Text } 100 101instance Arbitrary T where 102 arbitrary = fmap (T . T.pack) $ listOf1 $ elements $ concat 103 [ ['A'..'Z'] 104 , ['a'..'z'] 105 , ['0'..'9'] 106 , "-_" 107 ] 108