{-# LANGUAGE StrictData #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.Hspec.Formatters.GithubAction.Internal where
import Prelude
import Control.Applicative
import Test.Hspec.Core.Util (joinPath)
import Test.Hspec.Api.Formatters.V2
withGithubActionFormatter :: Formatter -> Formatter
withGithubActionFormatter :: Formatter -> Formatter
withGithubActionFormatter Formatter
fmtr = Formatter
fmtr
{ formatterItemDone :: Path -> Item -> FormatM ()
formatterItemDone = \Path
path Item
item -> do
Formatter -> Path -> Item -> FormatM ()
formatterItemDone Formatter
fmtr Path
path Item
item
Path -> Item -> FormatM ()
emitGithubActionAnnotation Path
path Item
item
}
data ErrorCommand = ErrorCommand
{ ErrorCommand -> Maybe String
title :: Maybe String
, ErrorCommand -> Maybe String
file :: Maybe String
, ErrorCommand -> Maybe Int
line :: Maybe Int
, ErrorCommand -> Maybe Int
col :: Maybe Int
, ErrorCommand -> String
message :: String
}
errorCommandFor :: Path -> Item -> Maybe Location -> FailureReason -> ErrorCommand
errorCommandFor :: Path -> Item -> Maybe Location -> FailureReason -> ErrorCommand
errorCommandFor specPath :: Path
specPath@([String]
_nesting, String
requirement) Item
item Maybe Location
mFailureLocation FailureReason
reason = ErrorCommand
{
title :: Maybe String
title = forall a. a -> Maybe a
Just String
requirement
, file :: Maybe String
file = Location -> String
locationFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Location
mloc
, line :: Maybe Int
line = Location -> Int
locationLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Location
mloc
, col :: Maybe Int
col = Location -> Int
locationColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Location
mloc
, message :: String
message = [String] -> String
unlines ([String]
messageHeaderLines forall a. [a] -> [a] -> [a]
++ [String]
messageBodyLines)
}
where
mloc :: Maybe Location
mloc = Maybe Location
mFailureLocation forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Item -> Maybe Location
itemLocation Item
item
messageHeaderLines :: [String]
messageHeaderLines :: [String]
messageHeaderLines = Path -> String
joinPath Path
specPath forall a. a -> [a] -> [a]
: if Item -> String
itemInfo Item
item forall a. Eq a => a -> a -> Bool
== String
"" then [] else [Item -> String
itemInfo Item
item]
messageBodyLines :: [String]
messageBodyLines :: [String]
messageBodyLines = case FailureReason
reason of
FailureReason
NoReason -> []
Reason String
str -> [String
str]
ExpectedButGot Maybe String
preface String
expected String
actual ->
let bodyLines :: [String]
bodyLines =
[ forall a. Monoid a => [a] -> a
mconcat [String
"expected: ", String
expected]
, forall a. Monoid a => [a] -> a
mconcat [String
" got: ", String
actual ]
]
headerLines :: [String]
headerLines = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [String
x]) Maybe String
preface
in [String]
headerLines forall a. [a] -> [a] -> [a]
++ [String]
bodyLines
Error Maybe String
preface SomeException
err ->
let bodyLines :: [String]
bodyLines = [forall a. Show a => a -> String
show SomeException
err]
headerLines :: [String]
headerLines = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [String
x]) Maybe String
preface
in [String]
headerLines forall a. [a] -> [a] -> [a]
++ [String]
bodyLines
formatErrorCommand :: ErrorCommand -> String
formatErrorCommand :: ErrorCommand -> String
formatErrorCommand ErrorCommand
ec = forall a. Monoid a => [a] -> a
mconcat
[ String
"\n::error "
, String
"title=", forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
escapeProperty (ErrorCommand -> Maybe String
title ErrorCommand
ec), String
","
, String
"file=", forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
escapeProperty (ErrorCommand -> Maybe String
file ErrorCommand
ec), String
","
, String
"line=", forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. Show a => a -> String
show (ErrorCommand -> Maybe Int
line ErrorCommand
ec), String
","
, String
"col=", forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. Show a => a -> String
show (ErrorCommand -> Maybe Int
col ErrorCommand
ec)
, String
"::"
, String -> String
escapeData (ErrorCommand -> String
message ErrorCommand
ec)
, String
"\n"
]
escapeData :: String -> String
escapeData :: String -> String
escapeData = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> String
replace)
where
replace :: Char -> String
replace Char
'%' = String
"%25"
replace Char
'\r' = String
"%0D"
replace Char
'\n' = String
"%0A"
replace Char
c = [Char
c]
escapeProperty :: String -> String
escapeProperty :: String -> String
escapeProperty = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> String
replace)
where
replace :: Char -> String
replace Char
'%' = String
"%25"
replace Char
'\r' = String
"%0D"
replace Char
'\n' = String
"%0A"
replace Char
':' = String
"%3A"
replace Char
',' = String
"%2C"
replace Char
c = [Char
c]
emitGithubActionAnnotation :: Path -> Item -> FormatM ()
emitGithubActionAnnotation :: Path -> Item -> FormatM ()
emitGithubActionAnnotation Path
path Item
item = case Item -> Result
itemResult Item
item of
Result
Success -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Pending Maybe Location
_ Maybe String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Failure Maybe Location
mLoc FailureReason
reason -> String -> FormatM ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorCommand -> String
formatErrorCommand forall a b. (a -> b) -> a -> b
$ Path -> Item -> Maybe Location -> FailureReason -> ErrorCommand
errorCommandFor Path
path Item
item Maybe Location
mLoc FailureReason
reason