darcsden-1.1: src/Test/Repository.hs

{-# LANGUAGE OverloadedStrings #-}
module Test.Repository where

import Control.Monad
import Control.Monad.Trans
import qualified Data.Text as T
import Data.Aeson.Types (Value)
import Test.WebDriver
import Test.WebDriver.Commands.Wait
import System.Random

findElem' :: Selector -> WD Element
findElem' = waitUntil 10 . findElem

createRepository :: WD String
createRepository = do
   (findElem'.ByCSS $ "li.home > a") >>= click -- click my repos
   (findElem'.ByCSS $ "li.create > a") >>= click -- click new repository
   elems <- mapM (findElem'.ById) ["name", "description"]
   rname <- liftIO $ replicateM 8 $ getStdRandom $ randomR ('a', 'z')
   mapM_ (uncurry sendKeys) (zip (map T.pack [rname, "webdriver test repo"]) elems)
   (findElem'.ByCSS $ "input[value=\"create repository\"]") >>= click
   return rname

createDirAndFile :: WD (String, String)
createDirAndFile = do
   d <- cf "input[value=\"directory\"]"
   f <- cf "input[value=\"file\"]"
   return (d, f)
 where
  cf s = do
   (findElem'.ByCSS $ "li.create > a") >>= click
   elems <- mapM (findElem'.ById) ["filename", "message"]
   name <- liftIO $ replicateM 8 $ getStdRandom $ randomR ('a', 'z')
   msg <- liftIO $ replicateM 8 $ getStdRandom $ randomR ('a', 'z')
   mapM_ (uncurry sendKeys) (zip (map T.pack [name, msg]) elems)
   (findElem'.ByCSS $ s) >>= click
   (findElem'.ByCSS $ "input[value=\"Create file/directory\"]") >>= click
   return name

editFile :: WD String
editFile = do
   (findElem'.ByCSS $ "li.edit > a") >>= click
   text <- liftIO $ fmap unlines $ replicateM 8 $ replicateM 8 $ getStdRandom $ randomR ('a', 'z')
   msg <- liftIO $ replicateM 8 $ getStdRandom $ randomR ('a', 'z')
   (findElem'.ById $ "message") >>= sendKeys (T.pack msg)
   executeJS [] (T.pack $ "window.cm.setValue(" ++ show text ++ ");") :: WD Value
   (findElem'.ByCSS $ "input[value=\"Update code\"]") >>= click
   return text