From 204348341560f69528c5b33f54f2e7d4706fd8f4 Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Sat, 15 Sep 2012 17:01:35 +0200 Subject: [PATCH] shakespeare-css: Convert spec to monadic-style --- shakespeare-css/shakespeare-css.cabal | 2 +- shakespeare-css/test.hs | 6 +- shakespeare-css/test/ShakespeareCssTest.hs | 160 ++++++++++----------- 3 files changed, 83 insertions(+), 85 deletions(-) diff --git a/shakespeare-css/shakespeare-css.cabal b/shakespeare-css/shakespeare-css.cabal index 3cb479e..59cf739 100644 --- a/shakespeare-css/shakespeare-css.cabal +++ b/shakespeare-css/shakespeare-css.cabal @@ -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 diff --git a/shakespeare-css/test.hs b/shakespeare-css/test.hs index 5aa085f..4a61168 100644 --- a/shakespeare-css/test.hs +++ b/shakespeare-css/test.hs @@ -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 diff --git a/shakespeare-css/test/ShakespeareCssTest.hs b/shakespeare-css/test/ShakespeareCssTest.hs index 2c9ac8c..284b823 100755 --- a/shakespeare-css/test/ShakespeareCssTest.hs +++ b/shakespeare-css/test/ShakespeareCssTest.hs @@ -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 @@ -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") @@ -45,22 +45,22 @@ 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 @@ -68,30 +68,30 @@ foo |] - , 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. */ @@ -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 @@ -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: /// |] @@ -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 @@ -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; @@ -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 @@ -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| @@ -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}" @@ -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| @@ -263,7 +262,7 @@ bin { |] - , it "cassius removes whitespace" $ do + it "cassius removes whitespace" $ do celper "foo{bar:baz}" [cassius| foo bar : baz @@ -273,16 +272,16 @@ 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| |] - , 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 { @@ -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 { @@ -370,7 +369,6 @@ foo { foo:X#{bar}Y; } } } |] - ] data Url = Home | Sub SubUrl data SubUrl = SubUrl