File: runtests.hs

package info (click to toggle)
haskell-css-text 0.1.2.2-3
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 76 kB
  • sloc: haskell: 225; makefile: 2
file content (103 lines) | stat: -rw-r--r-- 3,483 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
{-# 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 = 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']
        , "-_"
        ]