{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE CPP, PatternGuards, RecordWildCards, ViewPatterns #-}

-- | Check the <TEST> annotations within source and hint files.
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

-- Input, Output
-- Output = Nothing, should not match
-- Output = Just xs, should match xs
data TestCase = TestCase SrcLoc Refactor String (Maybe String) [Setting] deriving (Int -> TestCase -> ShowS
[TestCase] -> ShowS
TestCase -> String
(Int -> TestCase -> ShowS)
-> (TestCase -> String) -> ([TestCase] -> ShowS) -> Show TestCase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestCase -> ShowS
showsPrec :: Int -> TestCase -> ShowS
$cshow :: TestCase -> String
show :: TestCase -> String
$cshowList :: [TestCase] -> ShowS
showList :: [TestCase] -> ShowS
Show)

data Refactor = TestRefactor | SkipRefactor deriving (Refactor -> Refactor -> Bool
(Refactor -> Refactor -> Bool)
-> (Refactor -> Refactor -> Bool) -> Eq Refactor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Refactor -> Refactor -> Bool
== :: Refactor -> Refactor -> Bool
$c/= :: Refactor -> Refactor -> Bool
/= :: Refactor -> Refactor -> Bool
Eq, Int -> Refactor -> ShowS
[Refactor] -> ShowS
Refactor -> String
(Int -> Refactor -> ShowS)
-> (Refactor -> String) -> ([Refactor] -> ShowS) -> Show Refactor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Refactor -> ShowS
showsPrec :: Int -> Refactor -> ShowS
$cshow :: Refactor -> String
show :: Refactor -> String
$cshowList :: [Refactor] -> ShowS
showList :: [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 <- IO [TestCase] -> Test [TestCase]
forall a. IO a -> Test a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TestCase] -> Test [TestCase])
-> IO [TestCase] -> Test [TestCase]
forall a b. (a -> b) -> a -> b
$ String -> IO [TestCase]
parseTestFile String
file
    (TestCase -> Test ()) -> [TestCase] -> Test ()
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 <- IO (Either SomeException [Idea])
-> Test (Either SomeException [Idea])
forall a. IO a -> Test a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException [Idea])
 -> Test (Either SomeException [Idea]))
-> IO (Either SomeException [Idea])
-> Test (Either SomeException [Idea])
forall a b. (a -> b) -> a -> b
$ IO [Idea] -> IO (Either SomeException [Idea])
forall a. IO a -> IO (Either SomeException a)
try_ (IO [Idea] -> IO (Either SomeException [Idea]))
-> IO [Idea] -> IO (Either SomeException [Idea])
forall a b. (a -> b) -> a -> b
$ do
                [Idea]
res <- ParseFlags -> [Setting] -> String -> Maybe String -> IO [Idea]
applyHintFile ParseFlags
defaultParseFlags ([Setting]
setting [Setting] -> [Setting] -> [Setting]
forall a. [a] -> [a] -> [a]
++ [Setting]
additionalSettings) String
file (Maybe String -> IO [Idea]) -> Maybe String -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
inp
                Int -> IO Int
forall a. a -> IO a
evaluate (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ [Idea] -> String
forall a. Show a => a -> String
show [Idea]
res
                [Idea] -> IO [Idea]
forall a. a -> IO a
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 ([String] -> Test ()) -> [String] -> Test ()
forall a b. (a -> b) -> a -> b
$
                        [String
"TEST FAILURE (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ((SomeException -> Int)
-> ([Idea] -> Int) -> Either SomeException [Idea] -> Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int -> SomeException -> Int
forall a b. a -> b -> a
const Int
1) [Idea] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Either SomeException [Idea]
ideas) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" hints generated)"
                        ,String
"SRC: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
forall a. Outputable a => a -> String
unsafePrettyPrint SrcLoc
loc
                        ,String
"INPUT: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
inp] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                        ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"OUTPUT: " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ((SomeException -> [String])
-> ([Idea] -> [String]) -> Either SomeException [Idea] -> [String]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String])
-> (SomeException -> String) -> SomeException -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) ((Idea -> String) -> [Idea] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Idea -> String
forall a. Show a => a -> String
show) Either SomeException [Idea]
ideas) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                        [String
"WANTED: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"<failure>" Maybe String
out]
                        | Bool -> Bool
not Bool
good] [Test ()] -> [Test ()] -> [Test ()]
forall a. [a] -> [a] -> [a]
++
                    [[String] -> Test ()
failed
                        [String
"TEST FAILURE (BAD LOCATION)"
                        ,String
"SRC: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
forall a. Outputable a => a -> String
unsafePrettyPrint SrcLoc
loc
                        ,String
"INPUT: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
inp
                        ,String
"OUTPUT: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Idea -> String
forall a. Show a => a -> String
show Idea
i]
                        | i :: Idea
i@Idea{String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
SrcSpan
Severity
ideaModule :: [String]
ideaDecl :: [String]
ideaSeverity :: Severity
ideaHint :: String
ideaSpan :: SrcSpan
ideaFrom :: String
ideaTo :: Maybe String
ideaNote :: [Note]
ideaRefactoring :: [Refactoring SrcSpan]
ideaModule :: Idea -> [String]
ideaDecl :: Idea -> [String]
ideaSeverity :: Idea -> Severity
ideaHint :: Idea -> String
ideaSpan :: Idea -> SrcSpan
ideaFrom :: Idea -> String
ideaTo :: Idea -> Maybe String
ideaNote :: Idea -> [Note]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
..} <- [Idea] -> Either SomeException [Idea] -> [Idea]
forall b a. b -> Either a b -> b
fromRight [] Either SomeException [Idea]
ideas, let SrcLoc{Int
String
srcFilename :: String
srcLine :: Int
srcColumn :: Int
srcFilename :: SrcLoc -> String
srcLine :: SrcLoc -> Int
srcColumn :: SrcLoc -> Int
..} = SrcSpan -> SrcLoc
srcSpanStart SrcSpan
ideaSpan, String
srcFilename String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
|| Int
srcLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
srcColumn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0]
                        -- TODO: shouldn't these checks be == -1 instead?

            -- Skip refactoring test if the hlint test failed, or if the
            -- test is annotated with @NoRefactor.
            let skipRefactor :: Bool
skipRefactor = [Test ()] -> Bool
forall a. [a] -> Bool
notNull [Test ()]
bad Bool -> Bool -> Bool
|| Refactor
refact Refactor -> Refactor -> Bool
forall a. Eq a => a -> a -> Bool
== Refactor
SkipRefactor
            [Test ()]
badRefactor <- if Bool
skipRefactor then [Test ()] -> Test [Test ()]
forall a. a -> Test a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else IO [Test ()] -> Test [Test ()]
forall a. IO a -> Test a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Test ()] -> Test [Test ()]) -> IO [Test ()] -> Test [Test ()]
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 Maybe Idea
forall a. Maybe a
Nothing String
inp
                    Right [Idea
idea] -> Maybe String -> Maybe Idea -> String -> IO [String]
testRefactor Maybe String
rpath (Idea -> Maybe Idea
forall a. a -> Maybe a
Just Idea
idea) String
inp
                    -- Skip refactoring test if there are multiple hints
                    Either SomeException [Idea]
_ -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                [Test ()] -> IO [Test ()]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Test ()] -> IO [Test ()]) -> [Test ()] -> IO [Test ()]
forall a b. (a -> b) -> a -> b
$ [[String] -> Test ()
failed ([String] -> Test ()) -> [String] -> Test ()
forall a b. (a -> b) -> a -> b
$
                           [String
"TEST FAILURE (BAD REFACTORING)"
                           ,String
"SRC: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
forall a. Outputable a => a -> String
unsafePrettyPrint SrcLoc
loc
                           ,String
"INPUT: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
inp] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
refactorErr
                           | [String] -> Bool
forall a. [a] -> Bool
notNull [String]
refactorErr]

            if [Test ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Test ()]
bad Bool -> Bool -> Bool
&& [Test ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Test ()]
badRefactor then Test ()
passed else [Test ()] -> Test ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Test ()]
bad [Test ()] -> [Test ()] -> [Test ()]
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
msg
        match (String -> (String, String)
word1 -> (String
"@Note",String
note)) Idea
i = (Note -> String) -> [Note] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Note -> String
forall a. Show a => a -> String
show (Idea -> [Note]
ideaNote Idea
i) [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
note]
        match String
"@NoNote" Idea
i = [Note] -> Bool
forall a. [a] -> Bool
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Severity -> String
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 = (String -> String -> Bool) -> ShowS -> String -> String -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) ShowS
norm (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Idea -> Maybe String
ideaTo Idea
i) String
msg

        -- FIXME: Should use a better check for expected results
        norm :: ShowS
norm = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> ShowS) -> (Char -> Bool) -> ShowS
forall a b. (a -> b) -> a -> b
$ \Char
x -> Bool -> Bool
not (Char -> Bool
isSpace Char
x) Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';'


parseTestFile :: FilePath -> IO [TestCase]
parseTestFile :: String -> IO [TestCase]
parseTestFile String
file =
    -- we remove all leading # symbols since Yaml only lets us do comments that way
    Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f Maybe [Setting]
forall a. Maybe a
Nothing Refactor
TestRefactor ([(Int, String)] -> [TestCase])
-> (String -> [(Int, String)]) -> String -> [TestCase]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [(Int, String)]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
1 ([String] -> [(Int, String)])
-> (String -> [String]) -> String -> [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
dropPrefix String
"# ") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [TestCase]) -> IO String -> IO [TestCase]
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>" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
line =
             let suffix :: String
suffix = String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
dropPrefix String
"<TEST>" String
line
                 config :: Either ParseException ConfigYaml
config =
                   if String -> Bool
isBuiltinYaml String
file
                     then (ConfigYamlBuiltin -> ConfigYaml)
-> Either ParseException ConfigYamlBuiltin
-> Either ParseException ConfigYaml
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight ConfigYamlBuiltin -> ConfigYaml
getConfigYamlBuiltin (Either ParseException ConfigYamlBuiltin
 -> Either ParseException ConfigYaml)
-> Either ParseException ConfigYamlBuiltin
-> Either ParseException ConfigYaml
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException ConfigYamlBuiltin
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' (ByteString -> Either ParseException ConfigYamlBuiltin)
-> ByteString -> Either ParseException ConfigYamlBuiltin
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
suffix
                     else (ConfigYamlUser -> ConfigYaml)
-> Either ParseException ConfigYamlUser
-> Either ParseException ConfigYaml
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight ConfigYamlUser -> ConfigYaml
getConfigYamlUser (Either ParseException ConfigYamlUser
 -> Either ParseException ConfigYaml)
-> Either ParseException ConfigYamlUser
-> Either ParseException ConfigYaml
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException ConfigYamlUser
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' (ByteString -> Either ParseException ConfigYamlUser)
-> ByteString -> Either ParseException ConfigYamlUser
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
suffix
             in case Either ParseException ConfigYaml
config of
                  Left ParseException
err -> [Setting] -> Maybe [Setting]
forall a. a -> Maybe a
Just []
                  Right ConfigYaml
config -> [Setting] -> Maybe [Setting]
forall a. a -> Maybe a
Just ([Setting] -> Maybe [Setting]) -> [Setting] -> Maybe [Setting]
forall a b. (a -> b) -> a -> b
$ [ConfigYaml] -> [Setting]
settingsFromConfigYaml [ConfigYaml
config]
          | Bool
otherwise = Maybe [Setting]
forall a. Maybe a
Nothing

        shut :: String -> Bool
        shut :: String -> Bool
shut = String -> String -> Bool
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 Maybe [Setting]
forall a. Maybe a
Nothing Refactor
TestRefactor [(Int, String)]
xs
            | Just (String
x',String
_) <- String -> String -> Maybe (String, String)
forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix String
"@NoRefactor" String
x =
                Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f ([Setting] -> Maybe [Setting]
forall a. a -> Maybe a
Just [Setting]
s) Refactor
SkipRefactor ((Int
i, ShowS
trimEnd String
x' String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'\\' | String
"\\" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x]) (Int, String) -> [(Int, String)] -> [(Int, String)]
forall a. a -> [a] -> [a]
: [(Int, String)]
xs)
            | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x Bool -> Bool -> Bool
|| String
"-- " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f ([Setting] -> Maybe [Setting]
forall a. a -> Maybe a
Just [Setting]
s) Refactor
refact [(Int, String)]
xs
            | Just String
x <- String -> String -> Maybe String
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 ([Setting] -> Maybe [Setting]
forall a. a -> Maybe a
Just [Setting]
s) Refactor
refact ([(Int, String)] -> [TestCase]) -> [(Int, String)] -> [TestCase]
forall a b. (a -> b) -> a -> b
$ (Int
i,String
xString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
y)(Int, String) -> [(Int, String)] -> [(Int, String)]
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 TestCase -> [TestCase] -> [TestCase]
forall a. a -> [a] -> [a]
: Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
f ([Setting] -> Maybe [Setting]
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 = (String -> Maybe String -> [Setting] -> TestCase)
-> (String, Maybe String) -> [Setting] -> TestCase
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) ((String, Maybe String) -> [Setting] -> TestCase)
-> (String, Maybe String) -> [Setting] -> TestCase
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 <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"<COMMENT>" String
x = ShowS -> (String, Maybe String) -> (String, Maybe String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (String
"--"String -> ShowS
forall a. [a] -> [a] -> [a]
++) ((String, Maybe String) -> (String, Maybe String))
-> (String, Maybe String) -> (String, Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> (String, Maybe String)
f String
x
        f (Char
' ':Char
'-':Char
'-':String
xs) | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs Bool -> Bool -> Bool
|| String
" " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs = (String
"", String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ShowS
trimStart String
xs)
        f (Char
x:String
xs) = ShowS -> (String, Maybe String) -> (String, Maybe String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:) ((String, Maybe String) -> (String, Maybe String))
-> (String, Maybe String) -> (String, Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> (String, Maybe String)
f String
xs
        f [] = ([], Maybe String
forall a. Maybe a
Nothing)


-- Returns an empty list if the refactoring test passes, otherwise
-- returns error messages.
testRefactor :: Maybe FilePath -> Maybe Idea -> String -> IO [String]
-- Skip refactoring test if the refactor binary is not found.
testRefactor :: Maybe String -> Maybe Idea -> String -> IO [String]
testRefactor Maybe String
Nothing Maybe Idea
_ String
_ = [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
-- Skip refactoring test if there is no hint.
testRefactor Maybe String
_ Maybe Idea
Nothing String
_ = [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
-- Skip refactoring test if the hint has no suggestion (such as "Parse error" or "Avoid restricted function").
testRefactor Maybe String
_ (Just Idea
idea) String
_ | Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Idea -> Maybe String
ideaTo Idea
idea) = [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
-- Skip refactoring test if the hint does not support refactoring.
testRefactor Maybe String
_ (Just Idea
idea) String
_ | [Refactoring SrcSpan] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Idea -> [Refactoring SrcSpan]
ideaRefactoring Idea
idea) = [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
testRefactor (Just String
rpath) (Just Idea
idea) String
inp = (String -> IO [String]) -> IO [String]
forall a. (String -> IO a) -> IO a
withTempFile ((String -> IO [String]) -> IO [String])
-> (String -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \String
tempInp -> (String -> IO [String]) -> IO [String]
forall a. (String -> IO a) -> IO a
withTempFile ((String -> IO [String]) -> IO [String])
-> (String -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \String
tempHints -> do
    let refact :: (String, [Refactoring SrcSpan])
refact = (Idea -> String
forall a. Show a => a -> String
show Idea
idea, Idea -> [Refactoring SrcSpan]
ideaRefactoring Idea
idea)
        -- Ignores spaces and semicolons since unsafePrettyPrint may differ from apply-refact.
        process :: ShowS
process = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
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 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
/= [a]
y Bool -> Bool -> Bool
&& [a]
x [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSubsequenceOf` [a]
y
    String -> String -> IO ()
writeFile String
tempInp String
inp
    String -> String -> IO ()
writeFile String
tempHints ([(String, [Refactoring SrcSpan])] -> String
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
    [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ case ExitCode
exitCode of
        ExitFailure Int
ec -> [String
"Refactoring failed: exit code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ec]
        ExitCode
ExitSuccess -> case Idea -> Maybe String
ideaTo Idea
idea of
            -- The hint's suggested replacement is @Just ""@, which means the hint
            -- suggests removing something from the input. The refactoring output
            -- should be a proper subsequence of the input.
            Just String
"" | Bool -> Bool
not (String -> (String -> String -> Bool) -> String -> Bool
forall {t}. String -> (String -> String -> t) -> String -> t
matched String
refactored String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isProperSubsequenceOf String
inp) ->
                [String
"Refactor output is expected to be a proper subsequence of: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
inp, String
"Actual: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
refactored]
            -- The hint has a suggested replacement. The suggested replacement
            -- should be a substring of the refactoring output.
            Just String
to | Bool -> Bool
not (String -> (String -> String -> Bool) -> String -> Bool
forall {t}. String -> (String -> String -> t) -> String -> t
matched String
to String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
refactored) ->
                [String
"Refactor output is expected to contain: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
to, String
"Actual: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
refactored]
            Maybe String
_ -> []