1{-# LANGUAGE DeriveGeneric #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module      :  Distribution.Client.BuildReports.Types
5-- Copyright   :  (c) Duncan Coutts 2009
6-- License     :  BSD-like
7--
8-- Maintainer  :  cabal-devel@haskell.org
9-- Portability :  portable
10--
11-- Types related to build reporting
12--
13-----------------------------------------------------------------------------
14module Distribution.Client.BuildReports.Types (
15    ReportLevel(..),
16    BuildReport (..),
17    InstallOutcome(..),
18    Outcome(..),
19) where
20
21import Distribution.Client.Compat.Prelude
22import Prelude ()
23
24import qualified Distribution.Compat.CharParsing as P
25import qualified Text.PrettyPrint                as Disp
26
27import Distribution.Compiler           (CompilerId (..))
28import Distribution.PackageDescription (FlagAssignment)
29import Distribution.System             (Arch, OS)
30import Distribution.Types.PackageId    (PackageIdentifier)
31
32-------------------------------------------------------------------------------
33-- ReportLevel
34-------------------------------------------------------------------------------
35
36data ReportLevel = NoReports | AnonymousReports | DetailedReports
37  deriving (Eq, Ord, Enum, Bounded, Show, Generic)
38
39instance Binary ReportLevel
40instance Structured ReportLevel
41
42instance Pretty ReportLevel where
43  pretty NoReports        = Disp.text "none"
44  pretty AnonymousReports = Disp.text "anonymous"
45  pretty DetailedReports  = Disp.text "detailed"
46
47instance Parsec ReportLevel where
48  parsec = do
49    name <- P.munch1 isAlpha
50    case lowercase name of
51      "none"       -> return NoReports
52      "anonymous"  -> return AnonymousReports
53      "detailed"   -> return DetailedReports
54      _            -> P.unexpected $ "ReportLevel: " ++ name
55
56lowercase :: String -> String
57lowercase = map toLower
58
59-------------------------------------------------------------------------------
60-- BuildReport
61-------------------------------------------------------------------------------
62
63data BuildReport = BuildReport {
64    -- | The package this build report is about
65    package         :: PackageIdentifier,
66
67    -- | The OS and Arch the package was built on
68    os              :: OS,
69    arch            :: Arch,
70
71    -- | The Haskell compiler (and hopefully version) used
72    compiler        :: CompilerId,
73
74    -- | The uploading client, ie cabal-install-x.y.z
75    client          :: PackageIdentifier,
76
77    -- | Which configurations flags we used
78    flagAssignment  :: FlagAssignment,
79
80    -- | Which dependent packages we were using exactly
81    dependencies    :: [PackageIdentifier],
82
83    -- | Did installing work ok?
84    installOutcome  :: InstallOutcome,
85
86    --   Which version of the Cabal library was used to compile the Setup.hs
87--    cabalVersion    :: Version,
88
89    --   Which build tools we were using (with versions)
90--    tools      :: [PackageIdentifier],
91
92    -- | Configure outcome, did configure work ok?
93    docsOutcome     :: Outcome,
94
95    -- | Configure outcome, did configure work ok?
96    testsOutcome    :: Outcome
97  }
98  deriving (Eq, Show, Generic)
99
100
101
102-------------------------------------------------------------------------------
103-- InstallOutcome
104-------------------------------------------------------------------------------
105
106data InstallOutcome
107   = PlanningFailed
108   | DependencyFailed PackageIdentifier
109   | DownloadFailed
110   | UnpackFailed
111   | SetupFailed
112   | ConfigureFailed
113   | BuildFailed
114   | TestsFailed
115   | InstallFailed
116   | InstallOk
117  deriving (Eq, Show, Generic)
118
119instance Pretty InstallOutcome where
120  pretty PlanningFailed  = Disp.text "PlanningFailed"
121  pretty (DependencyFailed pkgid) = Disp.text "DependencyFailed" <+> pretty pkgid
122  pretty DownloadFailed  = Disp.text "DownloadFailed"
123  pretty UnpackFailed    = Disp.text "UnpackFailed"
124  pretty SetupFailed     = Disp.text "SetupFailed"
125  pretty ConfigureFailed = Disp.text "ConfigureFailed"
126  pretty BuildFailed     = Disp.text "BuildFailed"
127  pretty TestsFailed     = Disp.text "TestsFailed"
128  pretty InstallFailed   = Disp.text "InstallFailed"
129  pretty InstallOk       = Disp.text "InstallOk"
130
131instance Parsec InstallOutcome where
132  parsec = do
133    name <- P.munch1 isAlpha
134    case name of
135      "PlanningFailed"   -> return PlanningFailed
136      "DependencyFailed" -> DependencyFailed <$ P.spaces <*> parsec
137      "DownloadFailed"   -> return DownloadFailed
138      "UnpackFailed"     -> return UnpackFailed
139      "SetupFailed"      -> return SetupFailed
140      "ConfigureFailed"  -> return ConfigureFailed
141      "BuildFailed"      -> return BuildFailed
142      "TestsFailed"      -> return TestsFailed
143      "InstallFailed"    -> return InstallFailed
144      "InstallOk"        -> return InstallOk
145      _                  -> P.unexpected $ "InstallOutcome: " ++ name
146
147-------------------------------------------------------------------------------
148-- Outcome
149-------------------------------------------------------------------------------
150
151data Outcome = NotTried | Failed | Ok
152  deriving (Eq, Show, Enum, Bounded, Generic)
153
154instance Pretty Outcome where
155  pretty NotTried = Disp.text "NotTried"
156  pretty Failed   = Disp.text "Failed"
157  pretty Ok       = Disp.text "Ok"
158
159instance Parsec Outcome where
160  parsec = do
161    name <- P.munch1 isAlpha
162    case name of
163      "NotTried" -> return NotTried
164      "Failed"   -> return Failed
165      "Ok"       -> return Ok
166      _          -> P.unexpected $ "Outcome: " ++ name
167