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