Skip to content

Commit

Permalink
shakespeare-css: Convert spec to monadic-style
Browse files Browse the repository at this point in the history
  • Loading branch information
@sol
sol committed Sep 15, 2012
1 parent b22097c commit 2043483
Show file tree
Hide file tree
Showing 3 changed files with 83 additions and 85 deletions.
2 changes: 1 addition & 1 deletion shakespeare-css/shakespeare-css.cabal
View file
Expand Up @@ -54,7 +54,7 @@ test-suite test
, shakespeare
, base >= 4 && < 5
, HUnit
, hspec >= 1.1 && < 1.3
, hspec >= 1.3
, text >= 0.7 && < 0.12


Expand Down
6 changes: 3 additions & 3 deletions shakespeare-css/test.hs
View file
@@ -1,5 +1,5 @@
import Test.Hspec.Core
import ShakespeareCssTest (specs)
import Test.Hspec
import ShakespeareCssTest (spec)

main :: IO ()
main = hspec [specs]
main = hspec spec
160 changes: 79 additions & 81 deletions shakespeare-css/test/ShakespeareCssTest.hs
View file
@@ -1,10 +1,9 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module ShakespeareCssTest (specs) where
module ShakespeareCssTest (spec) where

import Test.HUnit hiding (Test)
import Test.Hspec
import Test.Hspec.HUnit ()

import Prelude hiding (reverse)
import Text.Cassius
Expand All @@ -17,25 +16,26 @@ import qualified Data.List as L
import Data.Text (Text, pack, unpack)
import Data.Monoid (mappend)

specs :: Spec
specs = describe "shakespeare-css"
[ it "cassius" caseCassius
, it "cassiusFile" caseCassiusFile
spec :: Spec
spec = do
describe "shakespeare-css" $ do
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/cassiuses/external1.cassius") $ concat
[ "foo {\n background: #000;\n bar: baz;\n color: #F00;\n}\n"
, "bin {\n"
, " background-image: url(url);\n"
, " bar: bar;\n color: #7F6405;\n fvarx: someval;\n unicode-test: שלום;\n"
, " urlp: url(url?p=q);\n}\n"
]
it "cassiusFileDebug" $ do
let var = "var"
let selector = "foo"
let urlp = (Home, [(pack "p", pack "q")])
flip celper $(cassiusFileDebug "test/cassiuses/external1.cassius") $ concat
[ "foo {\n background: #000;\n bar: baz;\n color: #F00;\n}\n"
, "bin {\n"
, " background-image: url(url);\n"
, " bar: bar;\n color: #7F6405;\n fvarx: someval;\n unicode-test: שלום;\n"
, " urlp: url(url?p=q);\n}\n"
]

{- TODO
, it "cassiusFileDebugChange" $ do
it "cassiusFileDebugChange" $ do
let var = "var"
writeFile "test/cassiuses/external2.cassius" "foo\n #{var}: 1"
celper "foo{var:1}" $(cassiusFileDebug "test/cassiuses/external2.cassius")
Expand All @@ -45,53 +45,53 @@ specs = describe "shakespeare-css"
-}


, it "comments" $ do
-- FIXME reconsider Hamlet comment syntax?
celper "" [cassius|/* this is a comment */
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|
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|
it "ignores a blank line" $ do
celper "foo{bar:baz}" [cassius|
foo

bar: baz

|]


, it "leading spaces" $
celper "foo{bar:baz}" [cassius|
it "leading spaces" $
celper "foo{bar:baz}" [cassius|
foo
bar: baz
|]


, it "cassius all spaces" $
celper "h1{color:green }" [cassius|
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|
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|
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. */
Expand All @@ -100,11 +100,10 @@ foo



, it "cassius module names" $
let foo = "foo"
dub = 3.14::Double
int = -5::Int
in
it "cassius module names" $ do
let foo = "foo"
dub = 3.14::Double
int = -5::Int
celper "sel{bar:oof oof 3.14 -5}"
[cassius|
sel
Expand All @@ -113,33 +112,33 @@ sel



, it "single dollar at and caret" $ do
celper "sel{att:$@^}" [cassius|
it "single dollar at and caret" $ do
celper "sel{att:$@^}" [cassius|
sel
att: $@^
|]

celper "sel{att:#{@{^{}" [cassius|
celper "sel{att:#{@{^{}" [cassius|
sel
att: #\{@\{^{
|]


, it "dollar operator" $ do
let val = (1, (2, 3)) :: (Integer, (Integer, Integer))
celper "sel{att:2}" [cassius|
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|
celper "sel{att:2}" [cassius|
sel
att: #{ show $ fst $ snd $ val}
|]



, it "embedded slash" $ do
celper "sel{att:///}" [cassius|
it "embedded slash" $ do
celper "sel{att:///}" [cassius|
sel
att: ///
|]
Expand All @@ -149,8 +148,8 @@ sel



, it "multi cassius" $ do
celper "foo{bar:baz;bar:bin}" [cassius|
it "multi cassius" $ do
celper "foo{bar:baz;bar:bin}" [cassius|
foo
bar: baz
bar: bin
Expand All @@ -161,10 +160,10 @@ foo



, it "lucius" $ do
let var = "var"
let urlp = (Home, [(pack "p", pack "q")])
flip celper [lucius|
it "lucius" $ do
let var = "var"
let urlp = (Home, [(pack "p", pack "q")])
flip celper [lucius|
foo {
background: #{colorBlack};
bar: baz;
Expand All @@ -188,7 +187,7 @@ bin {



, it "lucius file" $ do
it "lucius file" $ do
let var = "var"
let urlp = (Home, [(pack "p", pack "q")])
flip celper $(luciusFile "test/cassiuses/external1.lucius") $ concat
Expand All @@ -199,12 +198,12 @@ bin {
, "urlp:url(url?p=q)}"
]

, it "lucius file debug" caseLuciusFileDebug
it "lucius file debug" caseLuciusFileDebug




, it "lucius nested" $ do
it "lucius nested" $ do
celper "foo bar{baz:bin}" $(luciusFile "test/cassiuses/external-nested.lucius")
celper "foo bar {\n baz: bin;\n}\n" $(luciusFileDebug "test/cassiuses/external-nested.lucius")
celper "foo bar{baz:bin}" [lucius|
Expand All @@ -223,7 +222,7 @@ bin {
|]


, it "lucius charset" $ do
it "lucius charset" $ do
celper (concat ["@charset \"utf-8\";"
, "#content ul{list-style:none;padding:0 5em}"
, "#content ul li{padding:1em 0}"
Expand All @@ -249,7 +248,7 @@ bin {
}
|]

, it "lucius media" $ do
it "lucius media" $ do
celper "@media only screen{foo bar{baz:bin}}" $(luciusFile "test/cassiuses/external-media.lucius")
celper "@media only screen {\n foo bar {\n baz: bin;\n }\n}\n" $(luciusFileDebug "test/cassiuses/external-media.lucius")
celper "@media only screen{foo bar{baz:bin}}" [lucius|
Expand All @@ -263,7 +262,7 @@ bin {
|]


, it "cassius removes whitespace" $ do
it "cassius removes whitespace" $ do
celper "foo{bar:baz}" [cassius|
foo
bar : baz
Expand All @@ -273,82 +272,82 @@ bin {



, it "lucius trailing comments" $
it "lucius trailing comments" $
celper "foo{bar:baz}" [lucius|foo{bar:baz;}/* ignored*/|]

, it "lucius variables" $ celper "foo{bar:baz}" [lucius|
it "lucius variables" $ celper "foo{bar:baz}" [lucius|
@myvar: baz;
foo {
bar: #{myvar};
}
|]
, it "lucius CDO/CDC tokens" $
it "lucius CDO/CDC tokens" $
celper "*{a:b}" [lucius|
<!-- --> <!--
* {
a: b;
}
-->
|]
, it "lucius @import statements" $
it "lucius @import statements" $
celper "@import url(\"bla.css\");" [lucius|
@import url("bla.css");
|]
, it "lucius simple escapes" $
it "lucius simple escapes" $
celper "*{a:test}" [lucius|
* {
a: t\65 st;
}
|]
, it "lucius bounded escapes" $
it "lucius bounded escapes" $
celper "*{a:teft}" [lucius|
* {
a: t\000065ft;
}
|]
, it "lucius case-insensitive keywords" $
it "lucius case-insensitive keywords" $
celper "@media foo {}" [lucius|
@MeDIa foo {
}
|]
, it "lucius @page statements" $
it "lucius @page statements" $
celper "@page :right{a:b;c:d}" [lucius|
@page :right {
a:b;
c:d;
}
|]
, it "lucius @font-face statements" $
it "lucius @font-face statements" $
celper "@font-face{a:b;c:d}" [lucius|
@font-face {
a:b;
c:d;
}
|]
, it "lucius runtime" $ Right (T.pack "foo {\n bar: baz;\n}\n") @=? luciusRT (T.pack "foo { bar: #{myvar}}") [(TS.pack "myvar", TS.pack "baz")]
, it "lucius runtime variables" $ Right (T.pack "foo {\n bar: baz;\n}\n") @=? luciusRT (T.pack "@dummy: dummy; @myvar: baz; @dummy2: dummy; foo { bar: #{myvar}}") []
, it "lucius whtiespace" $ Right (T.pack "@media foo {\n bar {\n baz: bin;\n baz2: bin2;\n }\n}\n")
@=? luciusRT (T.pack "@media foo{bar{baz:bin;baz2:bin2}}") []
, it "variables inside value" $
it "lucius runtime" $ Right (T.pack "foo {\n bar: baz;\n}\n") @=? luciusRT (T.pack "foo { bar: #{myvar}}") [(TS.pack "myvar", TS.pack "baz")]
it "lucius runtime variables" $ Right (T.pack "foo {\n bar: baz;\n}\n") @=? luciusRT (T.pack "@dummy: dummy; @myvar: baz; @dummy2: dummy; foo { bar: #{myvar}}") []
it "lucius whtiespace" $ Right (T.pack "@media foo {\n bar {\n baz: bin;\n baz2: bin2;\n }\n}\n")
@=? luciusRT (T.pack "@media foo{bar{baz:bin;baz2:bin2}}") []
it "variables inside value" $
celper "foo{foo:XbarY}" [lucius|
@bar: bar;
foo { foo:X#{bar}Y; }
|]
, it "variables in media selector" $
it "variables in media selector" $
celper "@media (max-width: 400px){foo{color:red}}" [lucius|
@mobileWidth: 400px;
@media (max-width: #{mobileWidth}){ foo { color: red; } }
|]
, it "URLs in import" $ celper
it "URLs in import" $ celper
"@import url(\"suburl\");" [lucius|
@import url("@{Sub SubUrl}");
|]
, let charset = "mycharset"
in it "vars in charset" $ celper
"@charset mycharset;" [lucius|
it "vars in charset" $ do
let charset = "mycharset"
celper "@charset mycharset;" [lucius|
@charset #{charset};
|]
, it "keyframes" $ celper
it "keyframes" $ celper
"@keyframes mymove {from{top:0px}to{top:200px}}" [lucius|
@keyframes mymove {
from {
Expand All @@ -359,7 +358,7 @@ foo { foo:X#{bar}Y; }
}
}
|]
, it "prefixed keyframes" $ celper
it "prefixed keyframes" $ celper
"@-webkit-keyframes mymove {from{top:0px}to{top:200px}}" [lucius|
@-webkit-keyframes mymove {
from {
Expand All @@ -370,7 +369,6 @@ foo { foo:X#{bar}Y; }
}
}
|]
]

data Url = Home | Sub SubUrl
data SubUrl = SubUrl
Expand Down

0 comments on commit 2043483

Please sign in to comment.