blog-rekahsoft-ca/test/Main.hs
Collin J. Doering 2e3e7c5906 Update to newer base
- Due to some issue with the firefox webdriver plugin, selenium tests are temporarily disabled
  for firefox

Signed-off-by: Collin J. Doering <collin.doering@rekahsoft.ca>
2017-03-05 15:36:33 -05:00

117 lines
4.3 KiB
Haskell

-- (C) Copyright Collin J. Doering 2015
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
-- File: Main.hs
-- Author: Collin J. Doering <collin.doering@rekahsoft.ca>
-- Date: Feb 4, 2015
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Concurrent (threadDelay)
import Control.Exception (bracket)
import Control.Monad
import qualified Data.Text as T
import System.Process
import System.FilePath (takeExtension)
import System.Directory (getDirectoryContents, doesFileExist)
import Test.Hspec.WebDriver
import qualified Test.WebDriver.Commands.Wait as WDw
import qualified Test.WebDriver.Session as WDs
runSiteServerWith :: IO a -> IO ()
runSiteServerWith action = void $ bracket makeSiteProc terminateProcess (const action)
where makeSiteProc = do
let cp = shell "./site server"
cp' = cp { std_out = CreatePipe
, std_err = CreatePipe }
(_, _, _, ph) <- createProcess $ cp'
-- Pause for a moment to let http server start
threadDelay 250000
return ph
siteUrl :: String
siteUrl = "http://localhost:3000"
ensurePageLoaded :: WD ()
ensurePageLoaded = void $ WDw.waitUntil 10 $ findElem $ ById "page-content"
main :: IO ()
main = runSiteServerWith $ hspec $ do
describe "RekahSoft Blog Tests" $ do
-- session "for application cache" $ using [Firefox, Chrome] $ do
-- it "has a fresh cache manifest" $ do
-- pending
parallel $ session "general site navigation tests" $ using [chromeCaps] $ do
describe "navigation menuitems" $ do
context "when clicked" $ do
it "load the expected page and sets the menuitems parent as active" $ runWD $ do
openPage siteUrl
navItems <- findElems $ ByCSS "#nav a.menuitem"
flip mapM_ navItems $ \item -> do
itemHrefMaybe <- attr item "href"
itemHref <- case itemHrefMaybe of
Nothing -> fail "No href given on menuitem"
Just href -> return $ T.drop (length siteUrl) href
click item
ensurePageLoaded
activeItem <- findElem $ ByCSS $ "#nav li.active > a.menuitem[href=\"" `T.append` itemHref `T.append` "\"]"
activeItem `shouldBeTag` "a"
describe "blog Page" $ do
it "is paginated" $ runWD $ do
openPage $ siteUrl ++ "/blog1.html"
ensurePageLoaded
pagination <- findElem $ ById "pagination"
noFirstPage <- findElemFrom pagination $ ByCSS "span.on-first-page"
noPreviousPage <- findElemFrom pagination $ ByCSS "span.no-previous-page"
pagination `shouldBeTag` "div"
noFirstPage `shouldBeTag` "span"
noPreviousPage `shouldBeTag` "span"
describe "loads all pages (html files in site root)" $ do
pages <- runIO $ filterDir "_site"
it "opens the app index page" $ runWD $ do
openPage siteUrl
ensurePageLoaded
flip mapM_ pages $ \page -> do
it ("opens the " ++ page ++ " page") $ runWD $ do
openPage $ siteUrl ++ "/" ++ page
ensurePageLoaded
describe "Loads all posts (html files in posts/*)" $ do
posts <- runIO $ filterDir "_site/posts"
flip mapM_ posts $ \post -> do
it ("opens post with filename " ++ post) $ runWD $ do
openPage $ siteUrl ++ "/posts/" ++ post
ensurePageLoaded
filterDir :: FilePath -> IO [FilePath]
filterDir fp = do
dirList <- getDirectoryContents fp
filterM (\x -> doesFileExist x >>= \y ->
return (y && takeExtension x == ".html")) dirList