-- | Simple focus mechanism for @tasty@, similar to @hspec@.
-- Mark the root of your test tree with 'withFocus'.
-- Then, if any of the subtrees of your test suite are marked with 'focus', only those test trees will be run.
--
-- @
-- main = defaultMain . 'withFocus' $
--   testGroup "tests"
--     [ fooTests
--     , testGroup "subgroup"
--       [ 'focus' barTests
--       , bazTests
-- 	  ]
-- 	, quuxTests
--    ]
-- @

module Test.Tasty.Focus
  ( withFocus,
    focus,
  )
where

import Data.Monoid
import Data.Tagged
import Test.Tasty
import Test.Tasty.Options
import Test.Tasty.Runners

data Focused = Focused | NotFocused

instance IsOption Focused where
  defaultValue :: Focused
defaultValue = Focused
NotFocused
  parseValue :: String -> Maybe Focused
parseValue String
_ = Maybe Focused
forall a. Maybe a
Nothing
  optionName :: Tagged Focused String
optionName = String -> Tagged Focused String
forall k (s :: k) b. b -> Tagged s b
Tagged String
"focused"
  optionHelp :: Tagged Focused String
optionHelp = String -> Tagged Focused String
forall k (s :: k) b. b -> Tagged s b
Tagged String
"focused"

anyFocused :: TestTree -> Bool
anyFocused :: TestTree -> Bool
anyFocused = Any -> Bool
getAny (Any -> Bool) -> (TestTree -> Any) -> TestTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeFold Any -> OptionSet -> TestTree -> Any
forall b. Monoid b => TreeFold b -> OptionSet -> TestTree -> b
foldTestTree TreeFold Any
tfold OptionSet
forall a. Monoid a => a
mempty
  where
    tfold :: TreeFold Any
tfold = TreeFold Any
forall b. Monoid b => TreeFold b
trivialFold {foldSingle :: forall t. IsTest t => OptionSet -> String -> t -> Any
foldSingle = \OptionSet
opts String
_ t
_ -> Bool -> Any
Any (OptionSet -> Bool
focusedOpts OptionSet
opts)}
    focusedOpts :: OptionSet -> Bool
focusedOpts OptionSet
opts = case OptionSet -> Focused
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts of
      Focused
Focused -> Bool
True
      Focused
NotFocused -> Bool
False

-- | Intended to be used at the root of your test suite.
--   If any of the subtrees are focused, filter out all non-focused subtrees.
--   If there are no focused subtrees, return the entire tree.
withFocus :: TestTree -> TestTree
withFocus :: TestTree -> TestTree
withFocus TestTree
tree = if TestTree -> Bool
anyFocused TestTree
tree then TestTree -> TestTree
go TestTree
tree else TestTree
tree
  where
    go :: TestTree -> TestTree
go (PlusTestOptions OptionSet -> OptionSet
f TestTree
t) = case OptionSet -> Focused
forall v. IsOption v => OptionSet -> v
lookupOption (OptionSet -> OptionSet
f OptionSet
forall a. Monoid a => a
mempty) of
      Focused
NotFocused -> String -> [TestTree] -> TestTree
TestGroup String
"ignored" []
      Focused
Focused -> (OptionSet -> OptionSet) -> TestTree -> TestTree
PlusTestOptions OptionSet -> OptionSet
f TestTree
t
    go (TestGroup String
n [TestTree]
t) = String -> [TestTree] -> TestTree
TestGroup String
n ((TestTree -> TestTree) -> [TestTree] -> [TestTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestTree -> TestTree
go ([TestTree] -> [TestTree])
-> ([TestTree] -> [TestTree]) -> [TestTree] -> [TestTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestTree -> Bool) -> [TestTree] -> [TestTree]
forall a. (a -> Bool) -> [a] -> [a]
filter TestTree -> Bool
anyFocused ([TestTree] -> [TestTree]) -> [TestTree] -> [TestTree]
forall a b. (a -> b) -> a -> b
$ [TestTree]
t)
    go (SingleTest String
n t
t) = String -> t -> TestTree
forall t. IsTest t => String -> t -> TestTree
SingleTest String
n t
t
    go (WithResource ResourceSpec a
s IO a -> TestTree
k) = ResourceSpec a -> (IO a -> TestTree) -> TestTree
forall a. ResourceSpec a -> (IO a -> TestTree) -> TestTree
WithResource ResourceSpec a
s (TestTree -> TestTree
go (TestTree -> TestTree) -> (IO a -> TestTree) -> IO a -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> TestTree
k)
    go (AskOptions OptionSet -> TestTree
f) = (OptionSet -> TestTree) -> TestTree
AskOptions (TestTree -> TestTree
go (TestTree -> TestTree)
-> (OptionSet -> TestTree) -> OptionSet -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionSet -> TestTree
f)
    go (After DependencyType
d Expr
e TestTree
t) = DependencyType -> Expr -> TestTree -> TestTree
After DependencyType
d Expr
e (TestTree -> TestTree
go TestTree
t)

-- | Marks the tree as focused, as long as none of its subtrees are focused.
--
-- This funcion is marked as deprecated so that @-Werror@ will catch it if you accidentally leave tests focused.
focus :: TestTree -> TestTree
focus :: TestTree -> TestTree
focus TestTree
tree =
  if TestTree -> Bool
anyFocused TestTree
tree
    then TestTree
tree
    else String -> [TestTree] -> TestTree
testGroup String
"focused" [(OptionSet -> OptionSet) -> TestTree -> TestTree
PlusTestOptions (Focused -> OptionSet -> OptionSet
forall v. IsOption v => v -> OptionSet -> OptionSet
setOption Focused
Focused) TestTree
tree]

{-# WARNING focus "Focusing tests... don't forget to re-enable your entire test suite!" #-}