{-# LANGUAGE TypeApplications #-}

module Test.Tasty.Ext.Todo (
  testTreeTodo,
) where

import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import Test.Tasty.Options (
  IsOption (..),
  OptionDescription (..),
  flagCLParser,
  lookupOption,
  safeReadBool,
 )
import Test.Tasty.Providers (
  IsTest (..),
  TestName,
  testFailed,
  testPassed,
 )
import Test.Tasty.Runners (Result (..), TestTree (..))

data TodoTest = TodoTest
  deriving (Typeable)

instance IsTest TodoTest where
  run :: OptionSet -> TodoTest -> (Progress -> IO ()) -> IO Result
run OptionSet
opts TodoTest
_ Progress -> IO ()
_ = Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
testResult{resultShortDescription :: String
resultShortDescription = String
"TODO"}
    where
      FailTodos Bool
shouldFail = OptionSet -> FailTodos
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      testResult :: Result
testResult =
        if Bool
shouldFail
          then String -> Result
testFailed String
"Failing because --fail-todos was set"
          else String -> Result
testPassed String
""

  testOptions :: Tagged TodoTest [OptionDescription]
testOptions = [OptionDescription] -> Tagged TodoTest [OptionDescription]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Proxy FailTodos -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy FailTodos
forall k (t :: k). Proxy t
Proxy @FailTodos)]

newtype FailTodos = FailTodos Bool
  deriving (Typeable)

instance IsOption FailTodos where
  defaultValue :: FailTodos
defaultValue = Bool -> FailTodos
FailTodos Bool
False
  parseValue :: String -> Maybe FailTodos
parseValue = (Bool -> FailTodos) -> Maybe Bool -> Maybe FailTodos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> FailTodos
FailTodos (Maybe Bool -> Maybe FailTodos)
-> (String -> Maybe Bool) -> String -> Maybe FailTodos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Bool
safeReadBool
  optionName :: Tagged FailTodos String
optionName = String -> Tagged FailTodos String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"fail-todos"
  optionHelp :: Tagged FailTodos String
optionHelp = String -> Tagged FailTodos String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Make TODO tests fail instead of succeeding"
  optionCLParser :: Parser FailTodos
optionCLParser = Maybe Char -> FailTodos -> Parser FailTodos
forall v. IsOption v => Maybe Char -> v -> Parser v
flagCLParser Maybe Char
forall a. Maybe a
Nothing (Bool -> FailTodos
FailTodos Bool
True)

-- | A TestTree representing a test that will be written at some point.
testTreeTodo :: TestName -> TestTree
testTreeTodo :: String -> TestTree
testTreeTodo String
name = String -> TodoTest -> TestTree
forall t. IsTest t => String -> t -> TestTree
SingleTest String
name TodoTest
TodoTest