Cabal-syntax/src/Distribution/Types/TestSuite.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3
   4 module Distribution.Types.TestSuite
   5   ( TestSuite (..)
   6   , emptyTestSuite
   7   , testType
   8   , testModules
   9   , testModulesAutogen
  10   ) where
  11
  12 import Distribution.Compat.Prelude
  13 import Prelude ()
  14
  15 import Distribution.Types.BuildInfo
  16 import Distribution.Types.TestSuiteInterface
  17 import Distribution.Types.TestType
  18 import Distribution.Types.UnqualComponentName
  19
  20 import Distribution.ModuleName
  21
  22 import qualified Distribution.Types.BuildInfo.Lens as L
  23
  24 -- | A \"test-suite\" stanza in a cabal file.
  25 data TestSuite = TestSuite
  26   { testName :: UnqualComponentName
  27   , testInterface :: TestSuiteInterface
  28   , testBuildInfo :: BuildInfo
  29   , testCodeGenerators :: [String]
  30   }
  31   deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
  32
  33 instance L.HasBuildInfo TestSuite where
  34   buildInfo f l = (\x -> l{testBuildInfo = x}) <$> f (testBuildInfo l)
  35
  36 instance Binary TestSuite
  37 instance Structured TestSuite
  38
  39 instance NFData TestSuite where rnf = genericRnf
  40
  41 instance Monoid TestSuite where
  42   mempty =
  43     TestSuite
  44       { testName = mempty
  45       , testInterface = mempty
  46       , testBuildInfo = mempty
  47       , testCodeGenerators = mempty
  48       }
  49   mappend = (<>)
  50
  51 instance Semigroup TestSuite where
  52   a <> b =
  53     TestSuite
  54       { testName = combineNames a b testName "test"
  55       , testInterface = combine testInterface
  56       , testBuildInfo = combine testBuildInfo
  57       , testCodeGenerators = combine testCodeGenerators
  58       }
  59     where
  60       combine field = field a `mappend` field b
  61
  62 emptyTestSuite :: TestSuite
  63 emptyTestSuite = mempty
  64
  65 testType :: TestSuite -> TestType
  66 testType test = case testInterface test of
  67   TestSuiteExeV10 ver _ -> TestTypeExe ver
  68   TestSuiteLibV09 ver _ -> TestTypeLib ver
  69   TestSuiteUnsupported testtype -> testtype
  70
  71 -- | Get all the module names from a test suite.
  72 testModules :: TestSuite -> [ModuleName]
  73 testModules test =
  74   ( case testInterface test of
  75       TestSuiteLibV09 _ m -> [m]
  76       _ -> []
  77   )
  78     ++ otherModules (testBuildInfo test)
  79
  80 -- | Get all the auto generated module names from a test suite.
  81 -- This are a subset of 'testModules'.
  82 testModulesAutogen :: TestSuite -> [ModuleName]
  83 testModulesAutogen test = autogenModules (testBuildInfo test)