diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `hspec-formatter-github` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Unreleased + +## 0.1.0.0 - 2023-12-07 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2023 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +# `hspec-formatter-github` + +This package provides an `hspec` `Formatter` that emits Github Actions Annotations. +This highlights test failures directly in the PR view. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hspec-formatter-github.cabal b/hspec-formatter-github.cabal new file mode 100644 --- /dev/null +++ b/hspec-formatter-github.cabal @@ -0,0 +1,131 @@ +cabal-version: 2.2 + +-- This file has been generated from package.yaml by hpack version 0.35.2. +-- +-- see: https://github.com/sol/hpack + +name: hspec-formatter-github +version: 0.1.0.0 +synopsis: A Formatter for hspec that provides Github Actions Annotations +description: Please see the README on GitHub at +category: Testing +homepage: https://github.com/MercuryTechnologies/hspec-formatter-github#readme +bug-reports: https://github.com/MercuryTechnologies/hspec-formatter-github/issues +author: Alex Vieth, Matt von Hagen +maintainer: mattp@mercury.com +copyright: 2023 Mercury Technologies +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/MercuryTechnologies/hspec-formatter-github + +library + exposed-modules: + Test.Hspec.Formatters.GithubAction + Test.Hspec.Formatters.GithubAction.Internal + other-modules: + Paths_hspec_formatter_github + autogen-modules: + Paths_hspec_formatter_github + hs-source-dirs: + src + default-extensions: + BlockArguments + DataKinds + DefaultSignatures + DeriveFunctor + DeriveGeneric + DeriveLift + DerivingStrategies + DerivingVia + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + ImportQualifiedPost + InstanceSigs + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NegativeLiterals + NumericUnderscores + OverloadedLabels + OverloadedStrings + PartialTypeSignatures + PatternSynonyms + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TypeApplications + TypeFamilies + UndecidableInstances + ViewPatterns + TypeOperators + NoForeignFunctionInterface + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + base >=4.14 && <5 + , hspec-api + , hspec-core + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Paths_hspec_formatter_github + autogen-modules: + Paths_hspec_formatter_github + hs-source-dirs: + test + default-extensions: + BlockArguments + DataKinds + DefaultSignatures + DeriveFunctor + DeriveGeneric + DeriveLift + DerivingStrategies + DerivingVia + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + ImportQualifiedPost + InstanceSigs + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NegativeLiterals + NumericUnderscores + OverloadedLabels + OverloadedStrings + PartialTypeSignatures + PatternSynonyms + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TypeApplications + TypeFamilies + UndecidableInstances + ViewPatterns + TypeOperators + NoForeignFunctionInterface + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -O0 + build-depends: + base >=4.14 && <5 + , hspec + , hspec-api + , hspec-core + , hspec-formatter-github + default-language: Haskell2010 diff --git a/src/Test/Hspec/Formatters/GithubAction.hs b/src/Test/Hspec/Formatters/GithubAction.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Formatters/GithubAction.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | This module provides a utility to allow you to have annotations on +-- test failures in GitHub Actions. +-- +-- To use this, you'll call 'registerGithubActionsAnnotations' with +-- a 'Formatter' of your choice. +-- +-- @ +-- main :: IO () +-- main = do +-- let hspecConfig = +-- 'registerGithubActionsAnnotations' 'checks' 'defaultConfig' +-- 'hspecWith' hspecConfig spec +-- @ +-- +-- This will make the @github@ formatter available. +-- +-- Then, to actually use the formatter, you can provide the argument +-- @--format=github@ on the command line or in a @.hspec@ file, or the +-- @HSPEC_FORMAT=github@ environment variable. +-- +-- To do this locally with @cabal@, you must use @cabal run@, as @cabal +-- test@ evidently does not allow you to pass @--test-arguments@ anymore? +-- +-- > $ cabal run $(test-target-name) -- --format=github +-- +-- The environment variable is easier to set in CI, probably. +-- +-- > $ HSPEC_FORMAT=github cabal test +-- +-- And you can use a file, if you really want to, for some reason. +-- +-- > $ echo "--format=github" >> .hspec +-- > $ cabal test +module Test.Hspec.Formatters.GithubAction + ( registerGithubActionsAnnotations + , withGithubActionFormatter + -- * Re-exported 'Formatter' + , silent + , checks + ) where + +import Test.Hspec.Formatters.GithubAction.Internal +import Test.Hspec.Api.Formatters.V2 + +-- | This function adds the GitHub Annotations to the underlying +-- 'Formatter' +registerGithubActionsAnnotations :: Formatter -> Config -> Config +registerGithubActionsAnnotations format = + registerFormatter ("github", withGithubActionFormatter format) diff --git a/src/Test/Hspec/Formatters/GithubAction/Internal.hs b/src/Test/Hspec/Formatters/GithubAction/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Formatters/GithubAction/Internal.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | This module is internal! Use at your own risk. Breaking changes to +-- this module will not necessarily be reflected in PVP versions. +module Test.Hspec.Formatters.GithubAction.Internal where + +import Prelude +import Control.Applicative +import Test.Hspec.Core.Util (joinPath) +import Test.Hspec.Api.Formatters.V2 + +-- | This option enhances a given 'Formatter' with annotations that will +-- show up on the correct test item failure. This allows you to use the +-- test output you want, and additionally get Github Action annotations. +withGithubActionFormatter :: Formatter -> Formatter +withGithubActionFormatter fmtr = fmtr + { formatterItemDone = \path item -> do + formatterItemDone fmtr path item + emitGithubActionAnnotation path item + } + +-- | A representation of the Github Actions error format. +data ErrorCommand = ErrorCommand + { title :: Maybe String + , file :: Maybe String + , line :: Maybe Int + , col :: Maybe Int + , message :: String + } + +-- | Make a suitable error annotation from an hspec failure. +-- +-- Not clear what to do with the Maybe Location here: do we use the one from +-- the Item, or this one? What if both or neither are available? +-- Also not clear whether to use itemInfo. +errorCommandFor :: Path -> Item -> Maybe Location -> FailureReason -> ErrorCommand +errorCommandFor specPath@(_nesting, requirement) item mFailureLocation reason = ErrorCommand + { -- requirement is used because it should always be non-empty and meaningful + title = Just requirement + , file = locationFile <$> mloc + , line = locationLine <$> mloc + , col = locationColumn <$> mloc + , message = unlines (messageHeaderLines ++ messageBodyLines) + } + where + -- prefer the location of the actual failure. if that is not present, + -- fall back to the test definition location + mloc = mFailureLocation <|> itemLocation item + -- Use the path to give a message header, so that the message is never empty. + -- Empty messages seem to cause github actions to ignore the annotation. + messageHeaderLines :: [String] + messageHeaderLines = joinPath specPath : if itemInfo item == "" then [] else [itemInfo item] + + messageBodyLines :: [String] + messageBodyLines = case reason of + NoReason -> [] + Reason str -> [str] + ExpectedButGot preface expected actual -> + let bodyLines = + [ mconcat ["expected: ", expected] + , mconcat [" got: ", actual ] + ] + headerLines = maybe [] (\x -> [x]) preface + in headerLines ++ bodyLines + Error preface err -> + let bodyLines = [show err] + headerLines = maybe [] (\x -> [x]) preface + in headerLines ++ bodyLines + +-- | The github actions command format. +formatErrorCommand :: ErrorCommand -> String +formatErrorCommand ec = mconcat + [ "\n::error " + , "title=", maybe "" escapeProperty (title ec), "," + , "file=", maybe "" escapeProperty (file ec), "," + , "line=", maybe "" show (line ec), "," + , "col=", maybe "" show (col ec) + , "::" + , escapeData (message ec) + -- FIXME should check if on windows and use \r\n, as this is what the + -- github library does. + , "\n" + ] + +{- +function escapeData(s: any): string { + return toCommandValue(s) + .replace(/%/g, '%25') + .replace(/\r/g, '%0D') + .replace(/\n/g, '%0A') +} +function escapeProperty(s: any): string { + return toCommandValue(s) + .replace(/%/g, '%25') + .replace(/\r/g, '%0D') + .replace(/\n/g, '%0A') + .replace(/:/g, '%3A') + .replace(/,/g, '%2C') +} +-} + +escapeData :: String -> String +escapeData = (>>= replace) + where + replace '%' = "%25" + replace '\r' = "%0D" + replace '\n' = "%0A" + replace c = [c] + +escapeProperty :: String -> String +escapeProperty = (>>= replace) + where + replace '%' = "%25" + replace '\r' = "%0D" + replace '\n' = "%0A" + replace ':' = "%3A" + replace ',' = "%2C" + replace c = [c] + +-- | If you want to extend +emitGithubActionAnnotation :: Path -> Item -> FormatM () +emitGithubActionAnnotation path item = case itemResult item of + Success -> pure () + Pending _ _ -> pure () + Failure mLoc reason -> write . formatErrorCommand $ errorCommandFor path item mLoc reason diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,15 @@ +module Main where + +import Test.Hspec +import Test.Hspec.Core.Runner +import Test.Hspec.Formatters.GithubAction + +main :: IO () +main = do + hspecWith (registerGithubActionsAnnotations checks defaultConfig) $ do + describe "it works" $ do + it "unmark pending to test" $ do + pendingWith "test is pending by default" + expectationFailure "oh no" + +