-- | 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.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 '.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropExtension
  where replacePathSepTo :: Char -> ShowS
replacePathSepTo c1 :: 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
$ \c2 :: 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
generatorImport :: 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 t :: Test
t = Test -> String
testModule Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "." 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 '_' ' ' 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
/= '_') 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 c1 :: b
c1 c2 :: 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
$ \c3 :: 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 t :: 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 t :: Test
t var :: String
var = "  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
var String -> ShowS
forall a. [a] -> [a] -> [a]
++ " <- " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
setup String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\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
  ]

-- | Quickcheck group generator prefix.
hedgehogPropertyGenerator :: Generator
hedgehogPropertyGenerator :: Generator
hedgehogPropertyGenerator = Generator :: String -> String -> String -> (Test -> String) -> Generator
Generator
  { generatorPrefix :: String
generatorPrefix = "hprop_"
  , generatorImport :: String
generatorImport = "import qualified Test.Tasty.Hedgehog as H\n"
  , generatorClass :: String
generatorClass  = ""
  , generatorSetup :: Test -> String
generatorSetup  = \t :: Test
t -> "pure $ H.testProperty \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\" " 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 = "prop_"
  , generatorImport :: String
generatorImport = "import qualified Test.Tasty.QuickCheck as QC\n"
  , generatorClass :: String
generatorClass  = ""
  , generatorSetup :: Test -> String
generatorSetup  = \t :: Test
t -> "pure $ QC.testProperty \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\" " 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 = "scprop_"
  , generatorImport :: String
generatorImport = "import qualified Test.Tasty.SmallCheck as SC\n"
  , generatorClass :: String
generatorClass  = ""
  , generatorSetup :: Test -> String
generatorSetup  = \t :: Test
t -> "pure $ SC.testProperty \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\" " 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 = "unit_"
  , generatorImport :: String
generatorImport = "import qualified Test.Tasty.HUnit as HU\n"
  , generatorClass :: String
generatorClass  = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ "class TestCase a where testCase :: String -> a -> IO T.TestTree\n"
    , "instance TestCase (IO ())                      where testCase n = pure . HU.testCase      n\n"
    , "instance TestCase (IO String)                  where testCase n = pure . HU.testCaseInfo  n\n"
    , "instance TestCase ((String -> IO ()) -> IO ()) where testCase n = pure . HU.testCaseSteps n\n"
    ]
  , generatorSetup :: Test -> String
generatorSetup  = \t :: Test
t -> "testCase \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\" " 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 = "spec_"
  , generatorImport :: String
generatorImport = "import qualified Test.Tasty.Hspec as HS\n"
  , generatorClass :: String
generatorClass  = ""
  , generatorSetup :: Test -> String
generatorSetup  = \t :: Test
t -> "HS.testSpec \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\" " 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 = "test_"
  , generatorImport :: String
generatorImport = ""
  , generatorClass :: String
generatorClass  = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ "class TestGroup a where testGroup :: String -> a -> IO T.TestTree\n"
    , "instance TestGroup T.TestTree        where testGroup _ a = pure a\n"
    , "instance TestGroup [T.TestTree]      where testGroup n a = pure $ T.testGroup n a\n"
    , "instance TestGroup (IO T.TestTree)   where testGroup _ a = a\n"
    , "instance TestGroup (IO [T.TestTree]) where testGroup n a = T.testGroup n <$> a\n"
    ]
  , generatorSetup :: Test -> String
generatorSetup  = \t :: Test
t -> "testGroup \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
name Test
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Test -> String
qualifyFunction Test
t
  }