{-# 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 Distribution.Compat.Prelude
import Prelude ()

data TestInstance = TestInstance
  { TestInstance -> 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
$c== :: OptionDescr -> OptionDescr -> Bool
== :: OptionDescr -> OptionDescr -> Bool
$c/= :: OptionDescr -> OptionDescr -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS OptionDescr
readsPrec :: Int -> ReadS OptionDescr
$creadList :: ReadS [OptionDescr]
readList :: ReadS [OptionDescr]
$creadPrec :: ReadPrec OptionDescr
readPrec :: ReadPrec OptionDescr
$creadListPrec :: ReadPrec [OptionDescr]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> OptionDescr -> ShowS
showsPrec :: Int -> OptionDescr -> ShowS
$cshow :: OptionDescr -> String
show :: OptionDescr -> String
$cshowList :: [OptionDescr] -> ShowS
showList :: [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
$c== :: OptionType -> OptionType -> Bool
== :: OptionType -> OptionType -> Bool
$c/= :: OptionType -> OptionType -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS OptionType
readsPrec :: Int -> ReadS OptionType
$creadList :: ReadS [OptionType]
readList :: ReadS [OptionType]
$creadPrec :: ReadPrec OptionType
readPrec :: ReadPrec OptionType
$creadListPrec :: ReadPrec [OptionType]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> OptionType -> ShowS
showsPrec :: Int -> OptionType -> ShowS
$cshow :: OptionType -> String
show :: OptionType -> String
$cshowList :: [OptionType] -> ShowS
showList :: [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
$c== :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS Result
readsPrec :: Int -> ReadS Result
$creadList :: ReadS [Result]
readList :: ReadS [Result]
$creadPrec :: ReadPrec Result
readPrec :: ReadPrec Result
$creadListPrec :: ReadPrec [Result]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> Result -> ShowS
showsPrec :: Int -> Result -> ShowS
$cshow :: Result -> String
show :: Result -> String
$cshowList :: [Result] -> ShowS
showList :: [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{groupName :: String
groupName = String
n, concurrently :: Bool
concurrently = Bool
True, groupTests :: [Test]
groupTests = [Test]
ts}