tasty-html 0.3 → 0.4
raw patch · 3 files changed
+77/−42 lines, 3 filesdep +filepathdep ~tasty
Dependencies added: filepath
Dependency ranges changed: tasty
Files
- CHANGELOG.md +5/−0
- Test/Tasty/Runners/Html.hs +69/−40
- tasty-html.cabal +3/−2
CHANGELOG.md view
@@ -1,3 +1,8 @@+0.4 - 2014-11-11+----------------++- Add option to load bootstrap assets externally.+ 0.3 ---
Test/Tasty/Runners/Html.hs view
@@ -10,7 +10,7 @@ ) where import Control.Applicative (Const(..), (<$))-import Control.Monad ((>=>), unless)+import Control.Monad ((>=>), unless, forM_) import Control.Monad.Trans.Class (lift) import Control.Concurrent.STM (atomically, readTVar) import qualified Control.Concurrent.STM as STM(retry)@@ -18,9 +18,10 @@ import Data.Monoid (Monoid(mempty,mappend), (<>), Sum(Sum,getSum)) import Data.Typeable (Typeable) import GHC.Generics (Generic)+import System.FilePath ((</>)) import qualified Data.Text.Lazy.IO as TIO import qualified Data.ByteString as B-import Control.Monad.State (StateT, evalStateT)+import Control.Monad.State (StateT, evalStateT, liftIO) import qualified Control.Monad.State as State (get, modify) import Data.Functor.Compose (Compose(Compose,getCompose)) import qualified Data.IntMap as IntMap@@ -55,6 +56,20 @@ optionName = Tagged "html" optionHelp = Tagged "A file path to store the test results in HTML" +-- | Path where external assets will be looked up+newtype AssetsPath = AssetsPath FilePath deriving (Typeable)++-- | Assets 'Option' for the HTML 'Ingredient'.+instance IsOption (Maybe AssetsPath) where+ defaultValue = Nothing+ parseValue = Just . Just . AssetsPath+ optionName = Tagged "assets"+ optionHelp = Tagged "Directory where HTML assets will be looked up. \+ \If not given the assets will be inlined within the \+ \HTML file. \+ \The following files must be present: \+ \`bootstrap.min.css`, `bootstrap.min.js`, `jquery-2.1.1.min.js`"+ {-| To run tests using this ingredient, use 'Tasty.defaultMainWithIngredients', passing 'htmlRunner' as one possible ingredient. This ingredient will run tests if you pass the @--html@ command line option. For example,@@ -63,7 +78,8 @@ -} htmlRunner :: Ingredient htmlRunner = TestReporter optionDescription $ \options testTree -> do- HtmlPath path <- lookupOption options+ HtmlPath htmlPath <- lookupOption options+ let mAssetsPath = lookupOption options return $ \statusMap -> do Const summary <- flip evalStateT 0 $ getCompose $ getTraversal $ Tasty.foldTestTree@@ -73,13 +89,15 @@ options testTree - -- Ignore ellapsed time+ -- Ignore elapsed time return $ const $ do- generateHtml summary path+ generateHtml summary htmlPath mAssetsPath return $ getSum (summaryFailures summary) == 0 where- optionDescription = [ Option (Proxy :: Proxy (Maybe HtmlPath)) ]+ optionDescription = [ Option (Proxy :: Proxy (Maybe HtmlPath))+ , Option (Proxy :: Proxy (Maybe AssetsPath))+ ] -- * Internal @@ -108,22 +126,24 @@ runTest statusMap _ testName _ = Traversal $ Compose $ do ix <- State.get - summary <- lift $ atomically $ do+ result <- lift $ atomically $ do status <- readTVar $ fromMaybe (error "Attempted to lookup test by index outside bounds") $ IntMap.lookup ix statusMap case status of- -- If the test is done, generate HTML for it- Done result- | Tasty.resultSuccessful result -> return $- mkSuccess testName $ Tasty.resultDescription result- | otherwise ->- return $ mkFailure testName $ Tasty.resultDescription result+ -- If the test is done, return the result+ Done result -> return result -- Otherwise the test has either not been started or is currently -- executing _ -> STM.retry + -- Generate HTML for the test+ msg <- liftIO . Tasty.formatMessage . Tasty.resultDescription $ result+ let summary = if Tasty.resultSuccessful result+ then mkSuccess testName msg+ else mkFailure testName msg+ Const summary <$ State.modify (+1) -- | To be used for a 'TestGroup' when folding the final 'TestTree'.@@ -148,21 +168,23 @@ -- | Generates the final HTML report. generateHtml :: Summary -- ^ Test summary. -> FilePath -- ^ Where to write.+ -> Maybe AssetsPath -- ^ Path to external assets -> IO ()-generateHtml summary path = do+generateHtml summary htmlPath mAssetsPath = do -- Helpers to load external assets let getRead = getDataFileName >=> B.readFile includeMarkup = getRead >=> return . H.unsafeByteString -- blaze-html 'script' doesn't admit HTML inside includeScript = getRead >=> \bs ->- return . H.unsafeByteString $ "<script \"type=text/javascript\">" <> bs <> "</script>"+ return . H.unsafeByteString $ "<script>" <> bs <> "</script>" + -- Only used when no external assets path specified bootStrapCss <- includeMarkup "data/bootstrap/dist/css/bootstrap.min.css" jQueryJs <- includeScript "data/jquery-2.1.1.min.js" bootStrapJs <- includeScript "data/bootstrap/dist/js/bootstrap.min.js" scriptJs <- includeScript "data/script.js" - TIO.writeFile path $+ TIO.writeFile htmlPath $ renderHtml $ H.docTypeHtml ! A.lang "en" $ do H.head $ do@@ -170,33 +192,40 @@ H.meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1.0" H.title "Tasty Test Results"- H.style bootStrapCss - jQueryJs- bootStrapJs- scriptJs+ case mAssetsPath of+ Nothing -> do H.style bootStrapCss+ jQueryJs+ bootStrapJs+ Just (AssetsPath assetsPath) -> do+ H.link ! A.rel "stylesheet"+ ! A.href (H.toValue $ assetsPath </> "bootstrap.min.css")+ forM_ ["bootstrap.min.js", "jquery-2.1.1.min.js", "bootstrap.min.js"] $ \str ->+ H.script ! A.src (H.toValue $ assetsPath </> str ) $ mempty - H.body $ H.div ! A.class_ "container" $ do- H.h1 ! A.class_ "text-center" $ "Tasty Test Results"- H.div ! A.class_ "row" $- if summaryFailures summary > Sum 0- then- H.div ! A.class_ "alert alert-danger" $- H.p ! A.class_ "lead text-center" $ do- H.toMarkup . getSum $ summaryFailures summary- " out of " :: Markup- H.toMarkup tests- " tests failed"- else- H.div ! A.class_ "alert alert-success" $- H.p ! A.class_ "lead text-center" $ do- "All " :: Markup- H.toMarkup tests- " tests passed"+ H.body $ do+ H.div ! A.class_ "container" $ do+ H.h1 ! A.class_ "text-center" $ "Tasty Test Results"+ H.div ! A.class_ "row" $+ if summaryFailures summary > Sum 0+ then+ H.div ! A.class_ "alert alert-danger" $+ H.p ! A.class_ "lead text-center" $ do+ H.toMarkup . getSum $ summaryFailures summary+ " out of " :: Markup+ H.toMarkup tests+ " tests failed"+ else+ H.div ! A.class_ "alert alert-success" $+ H.p ! A.class_ "lead text-center" $ do+ "All " :: Markup+ H.toMarkup tests+ " tests passed" - H.div ! A.class_ "row" $- H.div ! A.class_ "well" $- H.toMarkup $ treeMarkup $ htmlRenderer summary+ H.div ! A.class_ "row" $+ H.div ! A.class_ "well" $+ H.toMarkup $ treeMarkup $ htmlRenderer summary+ scriptJs where -- Total number of tests
tasty-html.cabal view
@@ -1,5 +1,5 @@ name: tasty-html-version: 0.3+version: 0.4 synopsis: Render tasty output to HTML description: A tasty ingredient to output test results in HTML5. license: MIT@@ -29,11 +29,12 @@ base >= 4.5 && < 5, bytestring >= 0.10, containers >= 0.5.0.0,+ filepath >= 1.3, generic-deriving >= 1.6.2, mtl >= 2.1.2, stm >= 2.4.2, tagged >= 0.7,- tasty >= 0.10,+ tasty >= 0.10.1, text >= 1.0, transformers >= 0.3.0.0, blaze-html >= 0.7