module Devtools.HLint (testTree) where
import Control.Applicative (empty, pure)
import Data.Function (($), (.), const)
import Data.Functor (void)
import Data.Semigroup ((<>))
import Data.String (String)
import Data.Typeable (Typeable)
import System.IO
import qualified Data.Foldable as Foldable
import qualified Language.Haskell.HLint as HLint
import qualified System.Console.CmdArgs.Verbosity as CmdArgs
import qualified Test.Tasty as Tasty
import qualified Test.Tasty.Providers as Tasty
import qualified Test.Tasty.Providers.ConsoleFormat as Tasty
newtype HLintTest = HLintTest [String]
deriving stock Typeable
instance Tasty.IsTest HLintTest where
run :: OptionSet -> HLintTest -> (Progress -> IO ()) -> IO Result
run OptionSet
_options (HLintTest [String]
arguments) Progress -> IO ()
_callback = [String] -> IO Result
runHLintTest [String]
arguments
testOptions :: Tagged HLintTest [OptionDescription]
testOptions = [OptionDescription] -> Tagged HLintTest [OptionDescription]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [OptionDescription]
forall (f :: * -> *) a. Alternative f => f a
empty
testTree :: [String] -> Tasty.TestTree
testTree :: [String] -> TestTree
testTree = String -> HLintTest -> TestTree
forall t. IsTest t => String -> t -> TestTree
Tasty.singleTest String
"hlint" (HLintTest -> TestTree)
-> ([String] -> HLintTest) -> [String] -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> HLintTest
HLintTest
runHLintTest :: [String] -> IO Tasty.Result
runHLintTest :: [String] -> IO Result
runHLintTest [String]
arguments = do
[Idea]
ideas <- [String] -> IO [Idea]
HLint.hlint ([String] -> IO [Idea]) -> [String] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ [String
"--quiet"] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
arguments [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"."]
Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ if [Idea] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Foldable.null [Idea]
ideas
then String -> Result
Tasty.testPassed String
forall (f :: * -> *) a. Alternative f => f a
empty
else String -> ResultDetailsPrinter -> Result
Tasty.testFailedDetails String
forall (f :: * -> *) a. Alternative f => f a
empty
(ResultDetailsPrinter -> Result)
-> (IO () -> ResultDetailsPrinter) -> IO () -> Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ConsoleFormatPrinter -> IO ()) -> ResultDetailsPrinter
Tasty.ResultDetailsPrinter
((Int -> ConsoleFormatPrinter -> IO ()) -> ResultDetailsPrinter)
-> (IO () -> Int -> ConsoleFormatPrinter -> IO ())
-> IO ()
-> ResultDetailsPrinter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsoleFormatPrinter -> IO ())
-> Int -> ConsoleFormatPrinter -> IO ()
forall a b. a -> b -> a
const
((ConsoleFormatPrinter -> IO ())
-> Int -> ConsoleFormatPrinter -> IO ())
-> (IO () -> ConsoleFormatPrinter -> IO ())
-> IO ()
-> Int
-> ConsoleFormatPrinter
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> ConsoleFormatPrinter -> IO ()
forall a b. a -> b -> a
const
(IO () -> Result) -> IO () -> Result
forall a b. (a -> b) -> a -> b
$ [String] -> IO ()
runHLintVerbose [String]
arguments
runHLintVerbose :: [String] -> IO ()
runHLintVerbose :: [String] -> IO ()
runHLintVerbose [String]
arguments = do
Verbosity -> IO ()
CmdArgs.setVerbosity Verbosity
CmdArgs.Normal
IO [Idea] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Idea] -> IO ())
-> ([String] -> IO [Idea]) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO [Idea]
HLint.hlint ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String]
arguments [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--", String
"."]