packages feed

shakespeare-css 0.10.1 → 0.10.2

raw patch · 8 files changed

+423/−2 lines, 8 filesdep ~hspec

Dependency ranges changed: hspec

Files

shakespeare-css.cabal view
@@ -1,5 +1,5 @@ name:            shakespeare-css-version:         0.10.1+version:         0.10.2 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -18,6 +18,14 @@ cabal-version:   >= 1.8 build-type:      Simple homepage:        http://www.yesodweb.com/book/templates+extra-source-files:+  test/external1.cassius+  test/external1.lucius+  test/external2.cassius+  test/external2.lucius+  test/external-media.lucius+  test/external-nested.lucius+  test/main.hs  library     build-depends:   base             >= 4       && < 5@@ -43,7 +51,7 @@                  , shakespeare      >= 0.10    && < 0.11                  , base             >= 4       && < 5                  , HUnit-                 , hspec >= 0.6.1 && < 0.7+                 , hspec            >= 0.8     && < 0.9                  , text             >= 0.7     && < 0.12
+ test/external-media.lucius view
@@ -0,0 +1,7 @@+@media only screen{+    foo {+        bar {+            baz: bin;+        }+    }+}
+ test/external-nested.lucius view
@@ -0,0 +1,5 @@+foo {+    bar {+        baz: bin;+    }+}
+ test/external1.cassius view
@@ -0,0 +1,11 @@+#{selector}+    background: #{colorBlack}+    bar: baz+    color: #{colorRed}+bin+    background-image: url(@{Home})+    bar: bar+    color: #{(((Color 127) 100) 5)}+    f#{var}x: someval+    unicode-test: שלום+    urlp: url(@?{urlp})
+ test/external1.lucius view
@@ -0,0 +1,13 @@+foo {+    background: #{colorBlack};+    bar: baz;+    color: #{colorRed};+}+bin {+    background-image: url(@{Home});+    bar: bar;+    color: #{(((Color 127) 100) 5)};+    f#{var}x: someval;+    unicode-test: שלום;+    urlp: url(@?{urlp});+}
+ test/external2.cassius view
@@ -0,0 +1,2 @@+foo+  #{var}: 2
+ test/external2.lucius view
@@ -0,0 +1,1 @@+foo{#{var}: 2}
+ test/main.hs view
@@ -0,0 +1,374 @@+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+import Test.HUnit hiding (Test)
+import Test.Hspec
+import Test.Hspec.HUnit ()
+
+import Prelude hiding (reverse)
+import Text.Cassius
+import Text.Lucius
+import Data.List (intercalate)
+import qualified Data.Text.Lazy as T
+import qualified Data.List
+import qualified Data.List as L
+import Data.Text (Text, pack, unpack)
+import Data.Monoid (mappend)
+
+main :: IO ()
+main = hspecX $ descriptions [specs]
+
+specs :: [Spec]
+specs = describe "hamlet"
+  [ it "cassius" caseCassius
+  , it "cassiusFile" caseCassiusFile
+
+  , it "cassiusFileDebug" $ do
+    let var = "var"
+    let selector = "foo"
+    let urlp = (Home, [(pack "p", pack "q")])
+    flip celper $(cassiusFileDebug "test/external1.cassius") $ concat
+        [ "foo{background:#000;bar:baz;color:#F00}"
+        , "bin{"
+        , "background-image:url(url);"
+        , "bar:bar;color:#7F6405;fvarx:someval;unicode-test:שלום;"
+        , "urlp:url(url?p=q)}"
+        ]
+
+{- TODO
+  , it "cassiusFileDebugChange" $ do
+    let var = "var"
+    writeFile "test/external2.cassius" "foo\n  #{var}: 1"
+    celper "foo{var:1}" $(cassiusFileDebug "test/external2.cassius")
+    writeFile "test/external2.cassius" "foo\n  #{var}: 2"
+    celper "foo{var:2}" $(cassiusFileDebug "test/external2.cassius")
+    writeFile "test/external2.cassius" "foo\n  #{var}: 1"
+    -}
+
+
+  , it "comments" $ do
+    -- FIXME reconsider Hamlet comment syntax?
+    celper "" [cassius|/* this is a comment */
+/* another comment */
+/*a third one*/|]
+
+
+  , it "cassius pseudo-class" $
+    flip celper [cassius|
+a:visited
+    color: blue
+|] "a:visited{color:blue}"
+
+
+  , it "ignores a blank line" $ do
+    celper "foo{bar:baz}" [cassius|
+foo
+
+    bar: baz
+
+|]
+
+
+  , it "leading spaces" $
+    celper "foo{bar:baz}" [cassius|
+  foo
+    bar: baz
+|]
+
+
+  , it "cassius all spaces" $
+    celper "h1{color:green }" [cassius|
+    h1
+        color: green 
+    |]
+
+
+  , it "cassius whitespace and colons" $ do
+    celper "h1:hover{color:green ;font-family:sans-serif}" [cassius|
+    h1:hover
+        color: green 
+        font-family:sans-serif
+    |]
+
+
+  , it "cassius trailing comments" $
+    celper "h1:hover {color:green ;font-family:sans-serif}" [cassius|
+    h1:hover /* Please ignore this */
+        color: green /* This is a comment. */
+        /* Obviously this is ignored too. */
+        font-family:sans-serif
+    |]
+
+
+
+  , it "cassius module names" $
+    let foo = "foo"
+        dub = 3.14::Double
+        int = -5::Int
+    in
+      celper "sel{bar:oof oof 3.14 -5}"
+        [cassius|
+sel
+    bar: #{Data.List.reverse foo} #{L.reverse foo} #{show dub} #{show int}
+|]
+
+
+
+  , it "single dollar at and caret" $ do
+    celper "sel{att:$@^}" [cassius|
+sel
+    att: $@^
+|]
+
+    celper "sel{att:#{@{^{}" [cassius|
+sel
+    att: #\{@\{^{
+|]
+
+
+  , it "dollar operator" $ do
+    let val = (1, (2, 3)) :: (Integer, (Integer, Integer))
+    celper "sel{att:2}" [cassius|
+sel
+    att: #{ show $ fst $ snd val }
+|]
+    celper "sel{att:2}" [cassius|
+sel
+    att: #{ show $ fst $ snd $ val}
+|]
+
+
+
+  , it "embedded slash" $ do
+    celper "sel{att:///}" [cassius|
+sel
+    att: ///
+|]
+
+
+
+
+
+
+  , it "multi cassius" $ do
+    celper "foo{bar:baz;bar:bin}" [cassius|
+foo
+    bar: baz
+    bar: bin
+|]
+
+
+
+
+
+
+  , it "lucius" $ do
+    let var = "var"
+    let urlp = (Home, [(pack "p", pack "q")])
+    flip celper [lucius|
+foo {
+    background: #{colorBlack};
+    bar: baz;
+    color: #{colorRed};
+}
+bin {
+        background-image: url(@{Home});
+        bar: bar;
+        color: #{(((Color 127) 100) 5)};
+        f#{var}x: someval;
+        unicode-test: שלום;
+        urlp: url(@?{urlp});
+}
+|] $ concat
+        [ "foo{background:#000;bar:baz;color:#F00}"
+        , "bin{"
+        , "background-image:url(url);"
+        , "bar:bar;color:#7F6405;fvarx:someval;unicode-test:שלום;"
+        , "urlp:url(url?p=q)}"
+        ]
+
+
+
+  , it "lucius file" $ do
+      let var = "var"
+      let urlp = (Home, [(pack "p", pack "q")])
+      flip celper $(luciusFile "test/external1.lucius") $ concat
+          [ "foo{background:#000;bar:baz;color:#F00}"
+          , "bin{"
+          , "background-image:url(url);"
+          , "bar:bar;color:#7F6405;fvarx:someval;unicode-test:שלום;"
+          , "urlp:url(url?p=q)}"
+          ]
+
+{-
+  , it "lucius file debug" caseLuciusFileDebug
+  -}
+
+
+
+
+  , it "lucius nested" $ do
+      celper "foo bar{baz:bin}" $(luciusFile "test/external-nested.lucius")
+      celper "foo bar{baz:bin}" $(luciusFileDebug "test/external-nested.lucius")
+      celper "foo bar{baz:bin}" [lucius|
+        foo {
+            bar {
+                baz: bin;
+            }
+        }
+        |]
+      celper "foo1 bar,foo2 bar{baz:bin}" [lucius|
+        foo1, foo2 {
+            bar {
+                baz: bin;
+            }
+        }
+        |]
+
+
+  , it "lucius charset" $ do
+      celper (concat ["@charset \"utf-8\";"
+        , "#content ul{list-style:none;padding:0 5em}"
+        , "#content ul li{padding:1em 0}"
+        , "#content ul li a{color:#419a56;font-family:'TeXGyreHerosBold',helvetica,arial,sans-serif;font-weight:bold;text-transform:uppercase;white-space:nowrap}"
+        ]) [lucius|
+@charset "utf-8";
+#content ul
+{
+    list-style: none;
+    padding: 0 5em;
+    li
+    {
+        padding: 1em 0;
+        a
+        {
+            color: #419a56;
+            font-family: 'TeXGyreHerosBold',helvetica,arial,sans-serif;
+            font-weight: bold;
+            text-transform: uppercase;
+            white-space: nowrap;
+        }
+    }
+}
+|]
+
+  , it "lucius media" $ do
+      celper "@media only screen{foo bar{baz:bin}}" $(luciusFile "test/external-media.lucius")
+      celper "@media only screen{foo bar{baz:bin}}" $(luciusFileDebug "test/external-media.lucius")
+      celper "@media only screen{foo bar{baz:bin}}" [lucius|
+        @media only screen{
+            foo {
+                bar {
+                    baz: bin;
+                }
+            }
+        }
+        |]
+
+
+  , it "cassius removes whitespace" $ do
+      celper "foo{bar:baz}" [cassius|
+      foo
+          bar     :    baz
+      |]
+
+
+
+
+
+  , it "lucius trailing comments" $
+      celper "foo{bar:baz}" [lucius|foo{bar:baz;}/* ignored*/|]
+  ]
+
+data Url = Home | Sub SubUrl
+data SubUrl = SubUrl
+render :: Url -> [(Text, Text)] -> Text
+render Home qs = pack "url" `mappend` showParams qs
+render (Sub SubUrl) qs = pack "suburl" `mappend` showParams qs
+
+showParams :: [(Text, Text)] -> Text
+showParams [] = pack ""
+showParams z =
+    pack $ '?' : intercalate "&" (map go z)
+  where
+    go (x, y) = go' x ++ '=' : go' y
+    go' = concatMap encodeUrlChar . unpack
+
+-- | Taken straight from web-encodings; reimplemented here to avoid extra
+-- dependencies.
+encodeUrlChar :: Char -> String
+encodeUrlChar c
+    -- List of unreserved characters per RFC 3986
+    -- Gleaned from http://en.wikipedia.org/wiki/Percent-encoding
+    | 'A' <= c && c <= 'Z' = [c]
+    | 'a' <= c && c <= 'z' = [c]
+    | '0' <= c && c <= '9' = [c]
+encodeUrlChar c@'-' = [c]
+encodeUrlChar c@'_' = [c]
+encodeUrlChar c@'.' = [c]
+encodeUrlChar c@'~' = [c]
+encodeUrlChar ' ' = "+"
+encodeUrlChar y =
+    let (a, c) = fromEnum y `divMod` 16
+        b = a `mod` 16
+        showHex' x
+            | x < 10 = toEnum $ x + (fromEnum '0')
+            | x < 16 = toEnum $ x - 10 + (fromEnum 'A')
+            | otherwise = error $ "Invalid argument to showHex: " ++ show x
+     in ['%', showHex' b, showHex' c]
+
+
+
+celper :: String -> CssUrl Url -> Assertion
+celper res h = do
+    let x = renderCssUrl render h
+    T.pack res @=? x
+
+caseCassius :: Assertion
+caseCassius = do
+    let var = "var"
+    let urlp = (Home, [(pack "p", pack "q")])
+    flip celper [cassius|
+foo
+    background: #{colorBlack}
+    bar: baz
+    color: #{colorRed}
+bin
+        background-image: url(@{Home})
+        bar: bar
+        color: #{(((Color 127) 100) 5)}
+        f#{var}x: someval
+        unicode-test: שלום
+        urlp: url(@?{urlp})
+|] $ concat
+        [ "foo{background:#000;bar:baz;color:#F00}"
+        , "bin{"
+        , "background-image:url(url);"
+        , "bar:bar;color:#7F6405;fvarx:someval;unicode-test:שלום;"
+        , "urlp:url(url?p=q)}"
+        ]
+
+caseCassiusFile :: Assertion
+caseCassiusFile = do
+    let var = "var"
+    let selector = "foo"
+    let urlp = (Home, [(pack "p", pack "q")])
+    flip celper $(cassiusFile "test/external1.cassius") $ concat
+        [ "foo{background:#000;bar:baz;color:#F00}"
+        , "bin{"
+        , "background-image:url(url);"
+        , "bar:bar;color:#7F6405;fvarx:someval;unicode-test:שלום;"
+        , "urlp:url(url?p=q)}"
+        ]
+
+instance Show Url where
+    show _ = "FIXME remove this instance show Url"
+
+
+caseLuciusFileDebug :: Assertion
+caseLuciusFileDebug = do
+    let var = "var"
+    writeFile "test/external2.lucius" "foo{#{var}: 1}"
+    celper "foo{var:1}" $(luciusFileDebug "test/external2.lucius")
+    writeFile "test/external2.lucius" "foo{#{var}: 2}"
+    celper "foo{var:2}" $(luciusFileDebug "test/external2.lucius")
+    writeFile "test/external2.lucius" "foo{#{var}: 1}"