-- | The test generator boilerplate module.
--
-- Any test that is supported (HUnit, HSpec, etc.) provides here, a
-- generator type with all the context necessary for outputting the
-- necessary boilerplate for the generated main function that will
-- run all the tests.

module Test.Tasty.Discover.Internal.Generator
  ( -- * Types
    Generator (..)
  , Test (..)

    -- * Generators
  , generators
  , getGenerator
  , getGenerators

    -- * Boilerplate Formatter
  , showSetup

    -- * Type Constructor
  , mkTest
  ) where

import Data.Function   (on)
import Data.List       (find, groupBy, isPrefixOf, sortOn)
import Data.Maybe      (fromJust)
import System.FilePath (dropExtension, isPathSeparator)

-- | The test type.
data Test = Test
  { Test -> String
testModule   :: String -- ^ Module name.
  , Test -> String
testFunction :: String -- ^ Function name.
  } 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)

-- | 'Test' constructor.
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

-- | The generator type.
data Generator = Generator
  { Generator -> String
generatorPrefix   :: String          -- ^ Generator prefix.
  , Generator -> [String]
generatorImports  :: [String]        -- ^ Module import path.
  , Generator -> String
generatorClass    :: String          -- ^ Generator class.
  , Generator -> Test -> String
generatorSetup    :: Test -> String  -- ^ Generator setup.
  }

-- | Module import qualifier.
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

-- | Function namer.
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

-- | Generator retriever (single).
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)

-- | Generator retriever (many).
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

-- | Boilerplate formatter.
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

-- | All types of tests supported for boilerplate generation.
generators :: [Generator]
generators :: [Generator]
generators =
  [ Generator
quickCheckPropertyGenerator
  , Generator
smallCheckPropertyGenerator
  , Generator
hedgehogPropertyGenerator
  , Generator
hunitTestCaseGenerator
  , Generator
hspecTestCaseGenerator
  , Generator
tastyTestGroupGenerator
  , Generator
tastyGenerator
  ]

-- | Quickcheck group generator prefix.
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
  }

-- | Quickcheck group generator prefix.
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
  }

-- | Smallcheck group generator prefix.
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
  }

-- | HUnit generator prefix.
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
  }

-- | Hspec generator prefix.
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
  }

-- | Tasty group generator prefix.
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
  }

-- | Tasty group generator prefix.
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
  }