From fce8c71a5c24072814e65d876933f07a8d3e9d0f Mon Sep 17 00:00:00 2001
From: Artyom <yom@artyom.me>
Date: Mon, 22 Aug 2016 17:10:29 +0300
Subject: [PATCH] Add web Markdown tests

---
 lib/View.hs      |  2 +-
 tests/WebSpec.hs | 30 ++++++++++++++++++++++++++----
 2 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/lib/View.hs b/lib/View.hs
index b51125a..f8e0447 100644
--- a/lib/View.hs
+++ b/lib/View.hs
@@ -678,7 +678,7 @@ renderCategoryInfo category = cached (CacheCategoryInfo (category^.uid)) $ do
         a_ [href_ ("/haskell/feed/category/" <> uidToText (category^.uid))] $
           img_ [src_ "/rss-alt.svg",
                 alt_ "category feed", title_ "category feed"]
-      a_ [href_ (categoryLink category)] $
+      a_ [href_ (categoryLink category), class_ "category-title"] $
         toHtml (category^.title)
       emptySpan "1em"
       span_ [class_ "group"] $
diff --git a/tests/WebSpec.hs b/tests/WebSpec.hs
index 6981c2d..4891119 100644
--- a/tests/WebSpec.hs
+++ b/tests/WebSpec.hs
@@ -37,6 +37,7 @@ tests :: IO ()
 tests = run $ do
   mainPageTests
   categoryTests
+  markdownTests
 
 mainPageTests :: Spec
 mainPageTests = session "main page" $ using Firefox $ do
@@ -90,6 +91,25 @@ categoryTests = session "categories" $ using Firefox $ do
     wd "doesn't have an add-category field" $ do
       checkNotPresent ".add-category"
 
+markdownTests :: Spec
+markdownTests = session "markdown" $ using Firefox $ do
+  openGuide "/"
+  describe "Markdown isn't allowed in category names" $ do
+    wd "when creating a category" $ do
+      changesURL $
+        sendKeys ("*foo*" <> _enter) =<< select ".add-category"
+      e <- select ".category-title"
+      e `shouldHaveText` "*foo*"
+    wd "when changing existing category's name" $ do
+      header <- select ".category h2"
+      editButton <- findElemFrom header (ByLinkText "edit")
+      click editButton
+      do inp <- select ".category form input[name=title]"
+         clearInput inp
+         sendKeys ("foo `bar`" <> _enter) inp
+         waitWhile 2 (expectNotStale inp)
+      e <- select ".category-title"
+      e `shouldHaveText` "foo `bar`"
 
 -----------------------------------------------------------------------------
 -- Utilities
@@ -115,10 +135,12 @@ _TODO = error "test not implemented"
 wd :: String -> WD a -> SpecWith (WdTestSession ())
 wd x act = it x (runWD (void act))
 
-_pause :: MonadIO m => m ()
-_pause = liftIO $ void $ do
-  putStr "press Enter to continue testing: "
-  getLine
+_pause :: WD ()
+_pause = do
+  liftIO $ putStr "press Enter to continue testing, or “q” to quit: "
+  x <- liftIO $ getLine
+  when (x == "q") $
+    expectationFailure "quit"
 
 checkPresent :: Text -> WD ()
 checkPresent x = do