diff --git a/TAP.idr b/TAP.idr index fdc3459..c34cbb0 100644 --- a/TAP.idr +++ b/TAP.idr @@ -356,26 +356,33 @@ parameters (skipNotes : Bool) all id <$> traverse (\t => run' (assert_smaller tests t)) tests' +export +filterMatchStr : List String -> String -> List String +filterMatchStr pats label = filter (\p => not $ p `isInfixOf` label) pats + mutual ||| filter tests by whether a string occurs in their name or in the name of ||| any of their parent groups export - filterMatch : Maybe String -> List Test -> List Test - filterMatch Nothing tests = tests - filterMatch (Just pat) tests = - mapMaybe (\t => filterMatch1 pat (assert_smaller tests t)) tests + filterMatch : List String -> List Test -> List Test + filterMatch [] tests = tests + filterMatch pats tests = + mapMaybe (\t => filterMatch1 pats $ assert_smaller tests t) tests ||| filter subtests by whether a string occurs in their name or in the name of ||| any of their parent groups. return `Nothing` if nothing remains export - filterMatch1 : String -> Test -> Maybe Test - filterMatch1 pat test@(One base) = - guard (pat `isInfixOf` base.label) $> test - filterMatch1 pat whole@(Group label tests) = - if pat `isInfixOf` label then Just whole else - let res = filterMatch (Just pat) tests in - guard (any isRealTest res) $> Group label res - filterMatch1 pat note@(Note _) = Just note + filterMatch1 : List String -> Test -> Maybe Test + filterMatch1 pats test@(One base) = do + guard $ null $ filterMatchStr pats base.label + pure test + filterMatch1 pats whole@(Group label tests) = + case filterMatchStr pats label of + [] => Just whole + rest => do let res = filterMatch rest tests + guard $ any isRealTest res + pure $ Group label res + filterMatch1 _ note@(Note _) = Just note ||| run some tests, and return `ExitSuccess` if they were all ok, and diff --git a/TAP/Options.idr b/TAP/Options.idr index 16e9b3f..4324e99 100644 --- a/TAP/Options.idr +++ b/TAP/Options.idr @@ -36,10 +36,10 @@ record Options where ||| which TAP version to output version : TAPVersion ||| `-F`, `--filter`: - ||| search for a substring in test or group names. - ||| if it is present in a group name then all subtests are run - ||| regardless of their own names - pattern : Maybe String + ||| search for substrings in test or group names. + ||| if there are several, then each must be present somewhere in the + ||| test's name or in the name of one of its parent groups + pattern : List String ||| `-c`, `--color`, `--colour`: ||| colour code test results and a few other things. ||| this is not TAP compliant so it is off by default. @@ -54,7 +54,7 @@ export defaultOpts : Options defaultOpts = Opts { version = V13, - pattern = Nothing, + pattern = [], color = False, skipComments = False } @@ -86,7 +86,7 @@ setTapVer ver opts = private setFilter : String -> Mod -setFilter str opts = pure $ {pattern := Just str} opts +setFilter str opts = pure $ {pattern $= (str ::)} opts parameters (header : String) mutual