1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE RankNTypes #-}
3
4-----------------------------------------------------------------------------
5-- |
6-- Module      :  Distribution.TestSuite
7-- Copyright   :  Thomas Tuegel 2010
8-- License     :  BSD3
9--
10-- Maintainer  :  cabal-devel@haskell.org
11-- Portability :  portable
12--
13-- This module defines the detailed test suite interface which makes it
14-- possible to expose individual tests to Cabal or other test agents.
15
16module Distribution.TestSuite
17    ( TestInstance(..)
18    , OptionDescr(..)
19    , OptionType(..)
20    , Test(..)
21    , Options
22    , Progress(..)
23    , Result(..)
24    , testGroup
25    ) where
26
27import Prelude ()
28import Distribution.Compat.Prelude
29
30data TestInstance = TestInstance
31    { run       :: IO Progress      -- ^ Perform the test.
32    , name      :: String           -- ^ A name for the test, unique within a
33                                    -- test suite.
34    , tags      :: [String]         -- ^ Users can select groups of tests by
35                                    -- their tags.
36    , options   :: [OptionDescr]    -- ^ Descriptions of the options recognized
37                                    -- by this test.
38    , setOption :: String -> String -> Either String TestInstance
39        -- ^ Try to set the named option to the given value. Returns an error
40        -- message if the option is not supported or the value could not be
41        -- correctly parsed; otherwise, a 'TestInstance' with the option set to
42        -- the given value is returned.
43    }
44
45data OptionDescr = OptionDescr
46    { optionName        :: String
47    , optionDescription :: String       -- ^ A human-readable description of the
48                                        -- option to guide the user setting it.
49    , optionType        :: OptionType
50    , optionDefault     :: Maybe String
51    }
52  deriving (Eq, Read, Show)
53
54data OptionType
55    = OptionFile
56        { optionFileMustExist   :: Bool
57        , optionFileIsDir       :: Bool
58        , optionFileExtensions  :: [String]
59        }
60    | OptionString
61        { optionStringMultiline :: Bool
62        }
63    | OptionNumber
64        { optionNumberIsInt     :: Bool
65        , optionNumberBounds    :: (Maybe String, Maybe String)
66        }
67    | OptionBool
68    | OptionEnum [String]
69    | OptionSet [String]
70    | OptionRngSeed
71  deriving (Eq, Read, Show)
72
73data Test
74    = Test TestInstance
75    | Group
76        { groupName     :: String
77        , concurrently  :: Bool
78            -- ^ If true, then children of this group may be run in parallel.
79            -- Note that this setting is not inherited by children. In
80            -- particular, consider a group F with "concurrently = False" that
81            -- has some children, including a group T with "concurrently =
82            -- True". The children of group T may be run concurrently with each
83            -- other, as long as none are run at the same time as any of the
84            -- direct children of group F.
85        , groupTests    :: [Test]
86        }
87    | ExtraOptions [OptionDescr] Test
88
89type Options = [(String, String)]
90
91data Progress = Finished Result
92              | Progress String (IO Progress)
93
94data Result = Pass
95            | Fail String
96            | Error String
97  deriving (Eq, Read, Show)
98
99-- | Create a named group of tests, which are assumed to be safe to run in
100-- parallel.
101testGroup :: String -> [Test] -> Test
102testGroup n ts = Group { groupName = n, concurrently = True, groupTests = ts }
103