{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE CPP, PatternGuards, RecordWildCards, ViewPatterns #-}
module Test.Annotations(testAnnotations, parseTestFile, TestCase(..)) where
import Control.Exception.Extra
import Control.Monad
import Control.Monad.IO.Class
import Data.Char
import Data.Either.Extra
import Data.Function
import Data.Functor
import Data.List.Extra
import Data.Maybe
import Data.Tuple.Extra
import System.Exit
import System.FilePath
import System.IO.Extra
import GHC.All
import Data.ByteString.Char8 qualified as BS
import Config.Type
import Idea
import Apply
import Extension
import Refact
import Test.Util
import Prelude
import Config.Yaml
import GHC.Data.FastString
import GHC.Util
import GHC.Types.SrcLoc
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
#ifdef HS_YAML
import Data.YAML.Aeson (decode1Strict)
import Data.YAML (Pos)
import Data.ByteString (ByteString)
decodeEither' :: ByteString -> Either (Pos, String) ConfigYaml
decodeEither' = decode1Strict
#else
import Data.Yaml
#endif
data TestCase = TestCase SrcLoc Refactor String (Maybe String) [Setting] deriving (Int -> TestCase -> ShowS
[TestCase] -> ShowS
TestCase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestCase] -> ShowS
$cshowList :: [TestCase] -> ShowS
show :: TestCase -> String
$cshow :: TestCase -> String
showsPrec :: Int -> TestCase -> ShowS
$cshowsPrec :: Int -> TestCase -> ShowS
Show)
data Refactor = TestRefactor | SkipRefactor deriving (Refactor -> Refactor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Refactor -> Refactor -> Bool
$c/= :: Refactor -> Refactor -> Bool
== :: Refactor -> Refactor -> Bool
$c== :: Refactor -> Refactor -> Bool
Eq, Int -> Refactor -> ShowS
[Refactor] -> ShowS
Refactor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Refactor] -> ShowS
$cshowList :: [Refactor] -> ShowS
show :: Refactor -> String
$cshow :: Refactor -> String
showsPrec :: Int -> Refactor -> ShowS
$cshowsPrec :: Int -> Refactor -> ShowS
Show)
testAnnotations :: [Setting] -> FilePath -> Maybe FilePath -> Test ()
testAnnotations :: [Setting] -> String -> Maybe String -> Test ()
testAnnotations [Setting]
setting String
file Maybe String
rpath = do
[TestCase]
tests <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [TestCase]
parseTestFile String
file
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TestCase -> Test ()
f [TestCase]
tests
where
f :: TestCase -> Test ()
f (TestCase SrcLoc
loc Refactor
refact String
inp Maybe String
out [Setting]
additionalSettings) = do
Either SomeException [Idea]
ideas <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Either SomeException a)
try_ forall a b. (a -> b) -> a -> b
$ do
[Idea]
res <- ParseFlags -> [Setting] -> String -> Maybe String -> IO [Idea]
applyHintFile ParseFlags
defaultParseFlags ([Setting]
setting forall a. [a] -> [a] -> [a]
++ [Setting]
additionalSettings) String
file forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
inp
forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show [Idea]
res
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Idea]
res
let good :: Bool
good = case (Maybe String
out, Either SomeException [Idea]
ideas) of
(Maybe String
Nothing, Right []) -> Bool
True
(Just String
x, Right [Idea
idea]) | String -> Idea -> Bool
match String
x Idea
idea -> Bool
True
(Maybe String, Either SomeException [Idea])
_ -> Bool
False
let bad :: [Test ()]
bad =
[[String] -> Test ()
failed forall a b. (a -> b) -> a -> b
$
[String
"TEST FAILURE (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Int
1) forall (t :: * -> *) a. Foldable t => t a -> Int
length Either SomeException [Idea]
ideas) forall a. [a] -> [a] -> [a]
++ String
" hints generated)"
,String
"SRC: " forall a. [a] -> [a] -> [a]
++ forall a. Outputable a => a -> String
unsafePrettyPrint SrcLoc
loc
,String
"INPUT: " forall a. [a] -> [a] -> [a]
++ String
inp] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (String
"OUTPUT: " forall a. [a] -> [a] -> [a]
++) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show) Either SomeException [Idea]
ideas) forall a. [a] -> [a] -> [a]
++
[String
"WANTED: " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe String
"<failure>" Maybe String
out]
| Bool -> Bool
not Bool
good] forall a. [a] -> [a] -> [a]
++
[[String] -> Test ()
failed
[String
"TEST FAILURE (BAD LOCATION)"
,String
"SRC: " forall a. [a] -> [a] -> [a]
++ forall a. Outputable a => a -> String
unsafePrettyPrint SrcLoc
loc
,String
"INPUT: " forall a. [a] -> [a] -> [a]
++ String
inp
,String
"OUTPUT: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Idea
i]
| i :: Idea
i@Idea{String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
SrcSpan
Severity
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaNote :: Idea -> [Note]
ideaTo :: Idea -> Maybe String
ideaFrom :: Idea -> String
ideaSpan :: Idea -> SrcSpan
ideaHint :: Idea -> String
ideaSeverity :: Idea -> Severity
ideaDecl :: Idea -> [String]
ideaModule :: Idea -> [String]
ideaRefactoring :: [Refactoring SrcSpan]
ideaNote :: [Note]
ideaTo :: Maybe String
ideaFrom :: String
ideaSpan :: SrcSpan
ideaHint :: String
ideaSeverity :: Severity
ideaDecl :: [String]
ideaModule :: [String]
..} <- forall b a. b -> Either a b -> b
fromRight [] Either SomeException [Idea]
ideas, let SrcLoc{Int
String
srcColumn :: SrcLoc -> Int
srcLine :: SrcLoc -> Int
srcFilename :: SrcLoc -> String
srcColumn :: Int
srcLine :: Int
srcFilename :: String
..} = SrcSpan -> SrcLoc
srcSpanStart SrcSpan
ideaSpan, String
srcFilename forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
|| Int
srcLine forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
srcColumn forall a. Eq a => a -> a -> Bool
== Int
0]
let skipRefactor :: Bool
skipRefactor = forall a. [a] -> Bool
notNull [Test ()]
bad Bool -> Bool -> Bool
|| Refactor
refact forall a. Eq a => a -> a -> Bool
== Refactor
SkipRefactor
[Test ()]
badRefactor <- if Bool
skipRefactor then forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
[String]
refactorErr <- case Either SomeException [Idea]
ideas of
Right [] -> Maybe String -> Maybe Idea -> String -> IO [String]
testRefactor Maybe String
rpath forall a. Maybe a
Nothing String
inp
Right [Idea
idea] -> Maybe String -> Maybe Idea -> String -> IO [String]
testRefactor Maybe String
rpath (forall a. a -> Maybe a
Just Idea
idea) String
inp
Either SomeException [Idea]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [[String] -> Test ()
failed forall a b. (a -> b) -> a -> b
$
[String
"TEST FAILURE (BAD REFACTORING)"
,String
"SRC: " forall a. [a] -> [a] -> [a]
++ forall a. Outputable a => a -> String
unsafePrettyPrint SrcLoc
loc
,String
"INPUT: " forall a. [a] -> [a] -> [a]
++ String
inp] forall a. [a] -> [a] -> [a]
++ [String]
refactorErr
| forall a. [a] -> Bool
notNull [String]
refactorErr]
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Test ()]
bad Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Test ()]
badRefactor then Test ()
passed else forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Test ()]
bad forall a. [a] -> [a] -> [a]
++ [Test ()]
badRefactor)
match :: String -> Idea -> Bool
match String
"???" Idea
_ = Bool
True
match (String -> (String, String)
word1 -> (String
"@Message",String
msg)) Idea
i = Idea -> String
ideaHint Idea
i forall a. Eq a => a -> a -> Bool
== String
msg
match (String -> (String, String)
word1 -> (String
"@Note",String
note)) Idea
i = forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show (Idea -> [Note]
ideaNote Idea
i) forall a. Eq a => a -> a -> Bool
== [String
note]
match String
"@NoNote" Idea
i = forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Idea -> [Note]
ideaNote Idea
i)
match (String -> (String, String)
word1 -> (Char
'@':String
sev, String
msg)) Idea
i = String
sev forall a. Eq a => a -> a -> Bool
== forall a. Show a => a -> String
show (Idea -> Severity
ideaSeverity Idea
i) Bool -> Bool -> Bool
&& String -> Idea -> Bool
match String
msg Idea
i
match String
msg Idea
i = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) ShowS
norm (forall a. a -> Maybe a -> a
fromMaybe String
"" forall a b. (a -> b) -> a -> b
$ Idea -> Maybe String
ideaTo Idea
i) String
msg
norm :: ShowS
norm = forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a -> b) -> a -> b
$ \Char
x -> Bool -> Bool
not (Char -> Bool
isSpace Char
x) Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
';'
parseTestFile :: FilePath -> IO [TestCase]
parseTestFile :: String -> IO [TestCase]
parseTestFile String
file =
Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f forall a. Maybe a
Nothing Refactor
TestRefactor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => [a] -> [a] -> [a]
dropPrefix String
"# ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
file
where
open :: String -> Maybe [Setting]
open :: String -> Maybe [Setting]
open String
line
| String
"<TEST>" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
line =
let suffix :: String
suffix = forall a. Eq a => [a] -> [a] -> [a]
dropPrefix String
"<TEST>" String
line
config :: Either ParseException ConfigYaml
config =
if String -> Bool
isBuiltinYaml String
file
then forall b c a. (b -> c) -> Either a b -> Either a c
mapRight ConfigYamlBuiltin -> ConfigYaml
getConfigYamlBuiltin forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
suffix
else forall b c a. (b -> c) -> Either a b -> Either a c
mapRight ConfigYamlUser -> ConfigYaml
getConfigYamlUser forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
suffix
in case Either ParseException ConfigYaml
config of
Left ParseException
err -> forall a. a -> Maybe a
Just []
Right ConfigYaml
config -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [ConfigYaml] -> [Setting]
settingsFromConfigYaml [ConfigYaml
config]
| Bool
otherwise = forall a. Maybe a
Nothing
shut :: String -> Bool
shut :: String -> Bool
shut = forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"</TEST>"
f :: Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f :: Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f Maybe [Setting]
Nothing Refactor
_ ((Int
i,String
x):[(Int, String)]
xs) = Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f (String -> Maybe [Setting]
open String
x) Refactor
TestRefactor [(Int, String)]
xs
f (Just [Setting]
s) Refactor
refact ((Int
i,String
x):[(Int, String)]
xs)
| String -> Bool
shut String
x = Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f forall a. Maybe a
Nothing Refactor
TestRefactor [(Int, String)]
xs
| Just (String
x',String
_) <- forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix String
"@NoRefactor" String
x =
Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f (forall a. a -> Maybe a
Just [Setting]
s) Refactor
SkipRefactor ((Int
i, ShowS
trimEnd String
x' forall a. [a] -> [a] -> [a]
++ [Char
'\\' | String
"\\" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x]) forall a. a -> [a] -> [a]
: [(Int, String)]
xs)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x Bool -> Bool -> Bool
|| String
"-- " forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f (forall a. a -> Maybe a
Just [Setting]
s) Refactor
refact [(Int, String)]
xs
| Just String
x <- forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix String
"\\" String
x, (Int
_,String
y):[(Int, String)]
ys <- [(Int, String)]
xs = Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f (forall a. a -> Maybe a
Just [Setting]
s) Refactor
refact forall a b. (a -> b) -> a -> b
$ (Int
i,String
xforall a. [a] -> [a] -> [a]
++String
"\n"forall a. [a] -> [a] -> [a]
++String
y)forall a. a -> [a] -> [a]
:[(Int, String)]
ys
| Bool
otherwise = Refactor -> String -> Int -> String -> [Setting] -> TestCase
parseTest Refactor
refact String
file Int
i String
x [Setting]
s forall a. a -> [a] -> [a]
: Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f (forall a. a -> Maybe a
Just [Setting]
s) Refactor
TestRefactor [(Int, String)]
xs
f Maybe [Setting]
_ Refactor
_ [] = []
parseTest :: Refactor -> String -> Int -> String -> [Setting] -> TestCase
parseTest :: Refactor -> String -> Int -> String -> [Setting] -> TestCase
parseTest Refactor
refact String
file Int
i String
x = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SrcLoc
-> Refactor -> String -> Maybe String -> [Setting] -> TestCase
TestCase (FastString -> Int -> Int -> SrcLoc
mkSrcLoc (String -> FastString
mkFastString String
file) Int
i Int
0) Refactor
refact) forall a b. (a -> b) -> a -> b
$ String -> (String, Maybe String)
f String
x
where
f :: String -> (String, Maybe String)
f String
x | Just String
x <- forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"<COMMENT>" String
x = forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (String
"--"forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ String -> (String, Maybe String)
f String
x
f (Char
' ':Char
'-':Char
'-':String
xs) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs Bool -> Bool -> Bool
|| String
" " forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs = (String
"", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ShowS
trimStart String
xs)
f (Char
x:String
xs) = forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Char
xforall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ String -> (String, Maybe String)
f String
xs
f [] = ([], forall a. Maybe a
Nothing)
testRefactor :: Maybe FilePath -> Maybe Idea -> String -> IO [String]
testRefactor :: Maybe String -> Maybe Idea -> String -> IO [String]
testRefactor Maybe String
Nothing Maybe Idea
_ String
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
testRefactor Maybe String
_ Maybe Idea
Nothing String
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
testRefactor Maybe String
_ (Just Idea
idea) String
_ | forall a. Maybe a -> Bool
isNothing (Idea -> Maybe String
ideaTo Idea
idea) = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
testRefactor Maybe String
_ (Just Idea
idea) String
_ | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Idea -> [Refactoring SrcSpan]
ideaRefactoring Idea
idea) = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
testRefactor (Just String
rpath) (Just Idea
idea) String
inp = forall a. (String -> IO a) -> IO a
withTempFile forall a b. (a -> b) -> a -> b
$ \String
tempInp -> forall a. (String -> IO a) -> IO a
withTempFile forall a b. (a -> b) -> a -> b
$ \String
tempHints -> do
let refact :: (String, [Refactoring SrcSpan])
refact = (forall a. Show a => a -> String
show Idea
idea, Idea -> [Refactoring SrcSpan]
ideaRefactoring Idea
idea)
process :: ShowS
process = forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
';')
matched :: String -> (String -> String -> t) -> String -> t
matched String
expected String -> String -> t
g String
actual = ShowS
process String
expected String -> String -> t
`g` ShowS
process String
actual
[a]
x isProperSubsequenceOf :: [a] -> [a] -> Bool
`isProperSubsequenceOf` [a]
y = [a]
x forall a. Eq a => a -> a -> Bool
/= [a]
y Bool -> Bool -> Bool
&& [a]
x forall a. Eq a => [a] -> [a] -> Bool
`isSubsequenceOf` [a]
y
String -> String -> IO ()
writeFile String
tempInp String
inp
String -> String -> IO ()
writeFile String
tempHints (forall a. Show a => a -> String
show [(String, [Refactoring SrcSpan])
refact])
ExitCode
exitCode <- String
-> String
-> String
-> [Extension]
-> [Extension]
-> String
-> IO ExitCode
runRefactoring String
rpath String
tempInp String
tempHints [Extension]
defaultExtensions [] String
"--inplace"
String
refactored <- String -> IO String
readFile String
tempInp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case ExitCode
exitCode of
ExitFailure Int
ec -> [String
"Refactoring failed: exit code " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
ec]
ExitCode
ExitSuccess -> case Idea -> Maybe String
ideaTo Idea
idea of
Just String
"" | Bool -> Bool
not (forall {t}. String -> (String -> String -> t) -> String -> t
matched String
refactored forall a. Eq a => [a] -> [a] -> Bool
isProperSubsequenceOf String
inp) ->
[String
"Refactor output is expected to be a proper subsequence of: " forall a. [a] -> [a] -> [a]
++ String
inp, String
"Actual: " forall a. [a] -> [a] -> [a]
++ String
refactored]
Just String
to | Bool -> Bool
not (forall {t}. String -> (String -> String -> t) -> String -> t
matched String
to forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
refactored) ->
[String
"Refactor output is expected to contain: " forall a. [a] -> [a] -> [a]
++ String
to, String
"Actual: " forall a. [a] -> [a] -> [a]
++ String
refactored]
Maybe String
_ -> []