module Devtools
  ( Config(..)
  , Target(..)
  , defaultConfig
  , defaultMain
  , main
  , testTree
  )
where

import Devtools.Config
import Devtools.Prelude
import System.IO (putStrLn)

import qualified Devtools.Dependencies as Dependencies
import qualified Devtools.HLint        as HLint
import qualified Test.Tasty            as Tasty

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: [String] -> [Target] -> Config
Config
  { hlintArguments :: [String]
hlintArguments = []
  , targets :: [Target]
targets        = []
  }

defaultMain :: IO ()
defaultMain :: IO ()
defaultMain = Config -> IO ()
main Config
defaultConfig

main :: Config -> IO ()
main :: Config -> IO ()
main Config
config = do
  String -> IO ()
putStrLn String
forall (f :: * -> *) a. Alternative f => f a
empty
  TestTree -> IO ()
Tasty.defaultMain (TestTree -> IO ()) -> IO TestTree -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Config -> IO TestTree
testTree Config
config

testTree :: Config -> IO Tasty.TestTree
testTree :: Config -> IO TestTree
testTree Config{[String]
[Target]
targets :: [Target]
hlintArguments :: [String]
targets :: Config -> [Target]
hlintArguments :: Config -> [String]
..} = do
  String
filename <- IO String
Dependencies.getFilename

  TestTree -> IO TestTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestTree -> IO TestTree) -> TestTree -> IO TestTree
forall a b. (a -> b) -> a -> b
$ String -> [TestTree] -> TestTree
Tasty.testGroup
    String
"devtools"
    [ String -> [Target] -> TestTree
Dependencies.testTree String
filename [Target]
targets
    , [String] -> TestTree
HLint.testTree [String]
hlintArguments
    ]