module Test.Tasty.Discover.Internal.Generator
(
Generator (..)
, Test (..)
, generators
, getGenerator
, getGenerators
, showSetup
, mkTest
) where
import Data.Function (on)
import Data.List (find, groupBy, isPrefixOf, sortOn)
import Data.Maybe (fromJust)
import System.FilePath (dropExtension, isPathSeparator)
data Test = Test
{ Test -> String
testModule :: String
, Test -> String
testFunction :: String
} deriving (Test -> Test -> Bool
(Test -> Test -> Bool) -> (Test -> Test -> Bool) -> Eq Test
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Test -> Test -> Bool
$c/= :: Test -> Test -> Bool
== :: Test -> Test -> Bool
$c== :: Test -> Test -> Bool
Eq, Int -> Test -> ShowS
[Test] -> ShowS
Test -> String
(Int -> Test -> ShowS)
-> (Test -> String) -> ([Test] -> ShowS) -> Show Test
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Test] -> ShowS
$cshowList :: [Test] -> ShowS
show :: Test -> String
$cshow :: Test -> String
showsPrec :: Int -> Test -> ShowS
$cshowsPrec :: Int -> Test -> ShowS
Show, Eq Test
Eq Test
-> (Test -> Test -> Ordering)
-> (Test -> Test -> Bool)
-> (Test -> Test -> Bool)
-> (Test -> Test -> Bool)
-> (Test -> Test -> Bool)
-> (Test -> Test -> Test)
-> (Test -> Test -> Test)
-> Ord Test
Test -> Test -> Bool
Test -> Test -> Ordering
Test -> Test -> Test
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Test -> Test -> Test
$cmin :: Test -> Test -> Test
max :: Test -> Test -> Test
$cmax :: Test -> Test -> Test
>= :: Test -> Test -> Bool
$c>= :: Test -> Test -> Bool
> :: Test -> Test -> Bool
$c> :: Test -> Test -> Bool
<= :: Test -> Test -> Bool
$c<= :: Test -> Test -> Bool
< :: Test -> Test -> Bool
$c< :: Test -> Test -> Bool
compare :: Test -> Test -> Ordering
$ccompare :: Test -> Test -> Ordering
$cp1Ord :: Eq Test
Ord)
mkTest :: FilePath -> String -> Test
mkTest :: String -> String -> Test
mkTest = String -> String -> Test
Test (String -> String -> Test) -> ShowS -> String -> String -> Test
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
replacePathSepTo Char
'.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropExtension
where replacePathSepTo :: Char -> ShowS
replacePathSepTo Char
c1 = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> ShowS) -> (Char -> Char) -> ShowS
forall a b. (a -> b) -> a -> b
$ \Char
c2 -> if Char -> Bool
isPathSeparator Char
c2 then Char
c1 else Char
c2
data Generator = Generator
{ Generator -> String
generatorPrefix :: String
, Generator -> [String]
generatorImports :: [String]
, Generator -> String
generatorClass :: String
, Generator -> Test -> String
generatorSetup :: Test -> String
}
qualifyFunction :: Test -> String
qualifyFunction :: Test -> String
qualifyFunction Test
t = Test -> String
testModule Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
testFunction Test
t
name :: Test -> String
name :: Test -> String
name = Char -> Char -> ShowS
forall b. Eq b => b -> b -> [b] -> [b]
chooser Char
'_' Char
' ' ShowS -> (Test -> String) -> Test -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
tail ShowS -> (Test -> String) -> Test -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') ShowS -> (Test -> String) -> Test -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test -> String
testFunction
where chooser :: b -> b -> [b] -> [b]
chooser b
c1 b
c2 = (b -> b) -> [b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> b) -> [b] -> [b]) -> (b -> b) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ \b
c3 -> if b
c3 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
c1 then b
c2 else b
c3
getGenerator :: Test -> Generator
getGenerator :: Test -> Generator
getGenerator Test
t = Maybe Generator -> Generator
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Generator -> Generator) -> Maybe Generator -> Generator
forall a b. (a -> b) -> a -> b
$ [Generator] -> Maybe Generator
getPrefix [Generator]
generators
where getPrefix :: [Generator] -> Maybe Generator
getPrefix = (Generator -> Bool) -> [Generator] -> Maybe Generator
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Test -> String
testFunction Test
t) (String -> Bool) -> (Generator -> String) -> Generator -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Generator -> String
generatorPrefix)
getGenerators :: [Test] -> [Generator]
getGenerators :: [Test] -> [Generator]
getGenerators =
([Generator] -> Generator) -> [[Generator]] -> [Generator]
forall a b. (a -> b) -> [a] -> [b]
map [Generator] -> Generator
forall a. [a] -> a
head ([[Generator]] -> [Generator])
-> ([Test] -> [[Generator]]) -> [Test] -> [Generator]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Generator -> Generator -> Bool) -> [Generator] -> [[Generator]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (Generator -> String) -> Generator -> Generator -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Generator -> String
generatorPrefix) ([Generator] -> [[Generator]])
-> ([Test] -> [Generator]) -> [Test] -> [[Generator]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Generator -> String) -> [Generator] -> [Generator]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Generator -> String
generatorPrefix ([Generator] -> [Generator])
-> ([Test] -> [Generator]) -> [Test] -> [Generator]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Test -> Generator) -> [Test] -> [Generator]
forall a b. (a -> b) -> [a] -> [b]
map Test -> Generator
getGenerator
showSetup :: Test -> String -> String
showSetup :: Test -> ShowS
showSetup Test
t String
var = String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
var String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <- " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
setup String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
where setup :: String
setup = Generator -> Test -> String
generatorSetup (Test -> Generator
getGenerator Test
t) Test
t
generators :: [Generator]
generators :: [Generator]
generators =
[ Generator
quickCheckPropertyGenerator
, Generator
smallCheckPropertyGenerator
, Generator
hedgehogPropertyGenerator
, Generator
hunitTestCaseGenerator
, Generator
hspecTestCaseGenerator
, Generator
tastyTestGroupGenerator
, Generator
tastyGenerator
]
hedgehogPropertyGenerator :: Generator
hedgehogPropertyGenerator :: Generator
hedgehogPropertyGenerator = Generator :: String -> [String] -> String -> (Test -> String) -> Generator
Generator
{ generatorPrefix :: String
generatorPrefix = String
"hprop_"
, generatorImports :: [String]
generatorImports = [String
"import qualified Test.Tasty.Hedgehog as H", String
"import Data.String (fromString)"]
, generatorClass :: String
generatorClass = String
""
, generatorSetup :: Test -> String
generatorSetup = \Test
t -> String
"pure $ H.testPropertyNamed \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" (fromString \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
qualifyFunction Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
qualifyFunction Test
t
}
quickCheckPropertyGenerator :: Generator
quickCheckPropertyGenerator :: Generator
quickCheckPropertyGenerator = Generator :: String -> [String] -> String -> (Test -> String) -> Generator
Generator
{ generatorPrefix :: String
generatorPrefix = String
"prop_"
, generatorImports :: [String]
generatorImports = [String
"import qualified Test.Tasty.QuickCheck as QC"]
, generatorClass :: String
generatorClass = String
""
, generatorSetup :: Test -> String
generatorSetup = \Test
t -> String
"pure $ QC.testProperty \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
qualifyFunction Test
t
}
smallCheckPropertyGenerator :: Generator
smallCheckPropertyGenerator :: Generator
smallCheckPropertyGenerator = Generator :: String -> [String] -> String -> (Test -> String) -> Generator
Generator
{ generatorPrefix :: String
generatorPrefix = String
"scprop_"
, generatorImports :: [String]
generatorImports = [String
"import qualified Test.Tasty.SmallCheck as SC"]
, generatorClass :: String
generatorClass = String
""
, generatorSetup :: Test -> String
generatorSetup = \Test
t -> String
"pure $ SC.testProperty \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
qualifyFunction Test
t
}
hunitTestCaseGenerator :: Generator
hunitTestCaseGenerator :: Generator
hunitTestCaseGenerator = Generator :: String -> [String] -> String -> (Test -> String) -> Generator
Generator
{ generatorPrefix :: String
generatorPrefix = String
"unit_"
, generatorImports :: [String]
generatorImports = [String
"import qualified Test.Tasty.HUnit as HU"]
, generatorClass :: String
generatorClass = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"class TestCase a where testCase :: String -> a -> IO T.TestTree\n"
, String
"instance TestCase (IO ()) where testCase n = pure . HU.testCase n\n"
, String
"instance TestCase (IO String) where testCase n = pure . HU.testCaseInfo n\n"
, String
"instance TestCase ((String -> IO ()) -> IO ()) where testCase n = pure . HU.testCaseSteps n\n"
]
, generatorSetup :: Test -> String
generatorSetup = \Test
t -> String
"testCase \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
qualifyFunction Test
t
}
hspecTestCaseGenerator :: Generator
hspecTestCaseGenerator :: Generator
hspecTestCaseGenerator = Generator :: String -> [String] -> String -> (Test -> String) -> Generator
Generator
{ generatorPrefix :: String
generatorPrefix = String
"spec_"
, generatorImports :: [String]
generatorImports = [String
"import qualified Test.Tasty.Hspec as HS"]
, generatorClass :: String
generatorClass = String
""
, generatorSetup :: Test -> String
generatorSetup = \Test
t -> String
"HS.testSpec \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
qualifyFunction Test
t
}
tastyTestGroupGenerator :: Generator
tastyTestGroupGenerator :: Generator
tastyTestGroupGenerator = Generator :: String -> [String] -> String -> (Test -> String) -> Generator
Generator
{ generatorPrefix :: String
generatorPrefix = String
"test_"
, generatorImports :: [String]
generatorImports = []
, generatorClass :: String
generatorClass = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"class TestGroup a where testGroup :: String -> a -> IO T.TestTree\n"
, String
"instance TestGroup T.TestTree where testGroup _ a = pure a\n"
, String
"instance TestGroup [T.TestTree] where testGroup n a = pure $ T.testGroup n a\n"
, String
"instance TestGroup (IO T.TestTree) where testGroup _ a = a\n"
, String
"instance TestGroup (IO [T.TestTree]) where testGroup n a = T.testGroup n <$> a\n"
]
, generatorSetup :: Test -> String
generatorSetup = \Test
t -> String
"testGroup \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
qualifyFunction Test
t
}
tastyGenerator :: Generator
tastyGenerator :: Generator
tastyGenerator = Generator :: String -> [String] -> String -> (Test -> String) -> Generator
Generator
{ generatorPrefix :: String
generatorPrefix = String
"tasty_"
, generatorImports :: [String]
generatorImports = [String
"import qualified Test.Tasty.Discover as TD"]
, generatorClass :: String
generatorClass = []
, generatorSetup :: Test -> String
generatorSetup = \Test
t -> String
"TD.tasty (TD.description \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" <> TD.name \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
qualifyFunction Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
qualifyFunction Test
t
}