{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.TestSuite
-- Copyright   :  Thomas Tuegel 2010
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module defines the detailed test suite interface which makes it
-- possible to expose individual tests to Cabal or other test agents.

module Distribution.TestSuite
    ( TestInstance(..)
    , OptionDescr(..)
    , OptionType(..)
    , Test(..)
    , Options
    , Progress(..)
    , Result(..)
    , testGroup
    ) where

import Prelude ()
import Distribution.Compat.Prelude

data TestInstance = TestInstance
    { TestInstance -> HasCallStack => IO Progress
run       :: IO Progress      -- ^ Perform the test.
    , TestInstance -> String
name      :: String           -- ^ A name for the test, unique within a
                                    -- test suite.
    , TestInstance -> [String]
tags      :: [String]         -- ^ Users can select groups of tests by
                                    -- their tags.
    , TestInstance -> [OptionDescr]
options   :: [OptionDescr]    -- ^ Descriptions of the options recognized
                                    -- by this test.
    , TestInstance -> String -> String -> Either String TestInstance
setOption :: String -> String -> Either String TestInstance
        -- ^ Try to set the named option to the given value. Returns an error
        -- message if the option is not supported or the value could not be
        -- correctly parsed; otherwise, a 'TestInstance' with the option set to
        -- the given value is returned.
    }

data OptionDescr = OptionDescr
    { OptionDescr -> String
optionName        :: String
    , OptionDescr -> String
optionDescription :: String       -- ^ A human-readable description of the
                                        -- option to guide the user setting it.
    , OptionDescr -> OptionType
optionType        :: OptionType
    , OptionDescr -> Maybe String
optionDefault     :: Maybe String
    }
  deriving (OptionDescr -> OptionDescr -> Bool
(OptionDescr -> OptionDescr -> Bool)
-> (OptionDescr -> OptionDescr -> Bool) -> Eq OptionDescr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionDescr -> OptionDescr -> Bool
$c/= :: OptionDescr -> OptionDescr -> Bool
== :: OptionDescr -> OptionDescr -> Bool
$c== :: OptionDescr -> OptionDescr -> Bool
Eq, ReadPrec [OptionDescr]
ReadPrec OptionDescr
Int -> ReadS OptionDescr
ReadS [OptionDescr]
(Int -> ReadS OptionDescr)
-> ReadS [OptionDescr]
-> ReadPrec OptionDescr
-> ReadPrec [OptionDescr]
-> Read OptionDescr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OptionDescr]
$creadListPrec :: ReadPrec [OptionDescr]
readPrec :: ReadPrec OptionDescr
$creadPrec :: ReadPrec OptionDescr
readList :: ReadS [OptionDescr]
$creadList :: ReadS [OptionDescr]
readsPrec :: Int -> ReadS OptionDescr
$creadsPrec :: Int -> ReadS OptionDescr
Read, Int -> OptionDescr -> ShowS
[OptionDescr] -> ShowS
OptionDescr -> String
(Int -> OptionDescr -> ShowS)
-> (OptionDescr -> String)
-> ([OptionDescr] -> ShowS)
-> Show OptionDescr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionDescr] -> ShowS
$cshowList :: [OptionDescr] -> ShowS
show :: OptionDescr -> String
$cshow :: OptionDescr -> String
showsPrec :: Int -> OptionDescr -> ShowS
$cshowsPrec :: Int -> OptionDescr -> ShowS
Show)

data OptionType
    = OptionFile
        { OptionType -> Bool
optionFileMustExist   :: Bool
        , OptionType -> Bool
optionFileIsDir       :: Bool
        , OptionType -> [String]
optionFileExtensions  :: [String]
        }
    | OptionString
        { OptionType -> Bool
optionStringMultiline :: Bool
        }
    | OptionNumber
        { OptionType -> Bool
optionNumberIsInt     :: Bool
        , OptionType -> (Maybe String, Maybe String)
optionNumberBounds    :: (Maybe String, Maybe String)
        }
    | OptionBool
    | OptionEnum [String]
    | OptionSet [String]
    | OptionRngSeed
  deriving (OptionType -> OptionType -> Bool
(OptionType -> OptionType -> Bool)
-> (OptionType -> OptionType -> Bool) -> Eq OptionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionType -> OptionType -> Bool
$c/= :: OptionType -> OptionType -> Bool
== :: OptionType -> OptionType -> Bool
$c== :: OptionType -> OptionType -> Bool
Eq, ReadPrec [OptionType]
ReadPrec OptionType
Int -> ReadS OptionType
ReadS [OptionType]
(Int -> ReadS OptionType)
-> ReadS [OptionType]
-> ReadPrec OptionType
-> ReadPrec [OptionType]
-> Read OptionType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OptionType]
$creadListPrec :: ReadPrec [OptionType]
readPrec :: ReadPrec OptionType
$creadPrec :: ReadPrec OptionType
readList :: ReadS [OptionType]
$creadList :: ReadS [OptionType]
readsPrec :: Int -> ReadS OptionType
$creadsPrec :: Int -> ReadS OptionType
Read, Int -> OptionType -> ShowS
[OptionType] -> ShowS
OptionType -> String
(Int -> OptionType -> ShowS)
-> (OptionType -> String)
-> ([OptionType] -> ShowS)
-> Show OptionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionType] -> ShowS
$cshowList :: [OptionType] -> ShowS
show :: OptionType -> String
$cshow :: OptionType -> String
showsPrec :: Int -> OptionType -> ShowS
$cshowsPrec :: Int -> OptionType -> ShowS
Show)

data Test
    = Test TestInstance
    | Group
        { Test -> String
groupName     :: String
        , Test -> Bool
concurrently  :: Bool
            -- ^ If true, then children of this group may be run in parallel.
            -- Note that this setting is not inherited by children. In
            -- particular, consider a group F with "concurrently = False" that
            -- has some children, including a group T with "concurrently =
            -- True". The children of group T may be run concurrently with each
            -- other, as long as none are run at the same time as any of the
            -- direct children of group F.
        , Test -> [Test]
groupTests    :: [Test]
        }
    | ExtraOptions [OptionDescr] Test

type Options = [(String, String)]

data Progress = Finished Result
              | Progress String (IO Progress)

data Result = Pass
            | Fail String
            | Error String
  deriving (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, ReadPrec [Result]
ReadPrec Result
Int -> ReadS Result
ReadS [Result]
(Int -> ReadS Result)
-> ReadS [Result]
-> ReadPrec Result
-> ReadPrec [Result]
-> Read Result
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Result]
$creadListPrec :: ReadPrec [Result]
readPrec :: ReadPrec Result
$creadPrec :: ReadPrec Result
readList :: ReadS [Result]
$creadList :: ReadS [Result]
readsPrec :: Int -> ReadS Result
$creadsPrec :: Int -> ReadS Result
Read, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)

-- | Create a named group of tests, which are assumed to be safe to run in
-- parallel.
testGroup :: String -> [Test] -> Test
testGroup :: String -> [Test] -> Test
testGroup String
n [Test]
ts = Group :: String -> Bool -> [Test] -> Test
Group { groupName :: String
groupName = String
n, concurrently :: Bool
concurrently = Bool
True, groupTests :: [Test]
groupTests = [Test]
ts }