{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.BuildReports.Types
-- Copyright   :  (c) Duncan Coutts 2009
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Types related to build reporting
--
-----------------------------------------------------------------------------
module Distribution.Client.BuildReports.Types (
    ReportLevel(..),
    BuildReport (..),
    InstallOutcome(..),
    Outcome(..),
) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint                as Disp

import Distribution.Compiler           (CompilerId (..))
import Distribution.PackageDescription (FlagAssignment)
import Distribution.System             (Arch, OS)
import Distribution.Types.PackageId    (PackageIdentifier)

-------------------------------------------------------------------------------
-- ReportLevel
-------------------------------------------------------------------------------

data ReportLevel = NoReports | AnonymousReports | DetailedReports
  deriving (ReportLevel -> ReportLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReportLevel -> ReportLevel -> Bool
$c/= :: ReportLevel -> ReportLevel -> Bool
== :: ReportLevel -> ReportLevel -> Bool
$c== :: ReportLevel -> ReportLevel -> Bool
Eq, Eq ReportLevel
ReportLevel -> ReportLevel -> Bool
ReportLevel -> ReportLevel -> Ordering
ReportLevel -> ReportLevel -> ReportLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReportLevel -> ReportLevel -> ReportLevel
$cmin :: ReportLevel -> ReportLevel -> ReportLevel
max :: ReportLevel -> ReportLevel -> ReportLevel
$cmax :: ReportLevel -> ReportLevel -> ReportLevel
>= :: ReportLevel -> ReportLevel -> Bool
$c>= :: ReportLevel -> ReportLevel -> Bool
> :: ReportLevel -> ReportLevel -> Bool
$c> :: ReportLevel -> ReportLevel -> Bool
<= :: ReportLevel -> ReportLevel -> Bool
$c<= :: ReportLevel -> ReportLevel -> Bool
< :: ReportLevel -> ReportLevel -> Bool
$c< :: ReportLevel -> ReportLevel -> Bool
compare :: ReportLevel -> ReportLevel -> Ordering
$ccompare :: ReportLevel -> ReportLevel -> Ordering
Ord, Int -> ReportLevel
ReportLevel -> Int
ReportLevel -> [ReportLevel]
ReportLevel -> ReportLevel
ReportLevel -> ReportLevel -> [ReportLevel]
ReportLevel -> ReportLevel -> ReportLevel -> [ReportLevel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ReportLevel -> ReportLevel -> ReportLevel -> [ReportLevel]
$cenumFromThenTo :: ReportLevel -> ReportLevel -> ReportLevel -> [ReportLevel]
enumFromTo :: ReportLevel -> ReportLevel -> [ReportLevel]
$cenumFromTo :: ReportLevel -> ReportLevel -> [ReportLevel]
enumFromThen :: ReportLevel -> ReportLevel -> [ReportLevel]
$cenumFromThen :: ReportLevel -> ReportLevel -> [ReportLevel]
enumFrom :: ReportLevel -> [ReportLevel]
$cenumFrom :: ReportLevel -> [ReportLevel]
fromEnum :: ReportLevel -> Int
$cfromEnum :: ReportLevel -> Int
toEnum :: Int -> ReportLevel
$ctoEnum :: Int -> ReportLevel
pred :: ReportLevel -> ReportLevel
$cpred :: ReportLevel -> ReportLevel
succ :: ReportLevel -> ReportLevel
$csucc :: ReportLevel -> ReportLevel
Enum, ReportLevel
forall a. a -> a -> Bounded a
maxBound :: ReportLevel
$cmaxBound :: ReportLevel
minBound :: ReportLevel
$cminBound :: ReportLevel
Bounded, Int -> ReportLevel -> ShowS
[ReportLevel] -> ShowS
ReportLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportLevel] -> ShowS
$cshowList :: [ReportLevel] -> ShowS
show :: ReportLevel -> String
$cshow :: ReportLevel -> String
showsPrec :: Int -> ReportLevel -> ShowS
$cshowsPrec :: Int -> ReportLevel -> ShowS
Show, forall x. Rep ReportLevel x -> ReportLevel
forall x. ReportLevel -> Rep ReportLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReportLevel x -> ReportLevel
$cfrom :: forall x. ReportLevel -> Rep ReportLevel x
Generic)

instance Binary ReportLevel
instance Structured ReportLevel

instance Pretty ReportLevel where
  pretty :: ReportLevel -> Doc
pretty ReportLevel
NoReports        = String -> Doc
Disp.text String
"none"
  pretty ReportLevel
AnonymousReports = String -> Doc
Disp.text String
"anonymous"
  pretty ReportLevel
DetailedReports  = String -> Doc
Disp.text String
"detailed"

instance Parsec ReportLevel where
  parsec :: forall (m :: * -> *). CabalParsing m => m ReportLevel
parsec = do
    String
name <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlpha
    case ShowS
lowercase String
name of
      String
"none"       -> forall (m :: * -> *) a. Monad m => a -> m a
return ReportLevel
NoReports
      String
"anonymous"  -> forall (m :: * -> *) a. Monad m => a -> m a
return ReportLevel
AnonymousReports
      String
"detailed"   -> forall (m :: * -> *) a. Monad m => a -> m a
return ReportLevel
DetailedReports
      String
_            -> forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected forall a b. (a -> b) -> a -> b
$ String
"ReportLevel: " forall a. [a] -> [a] -> [a]
++ String
name

lowercase :: String -> String
lowercase :: ShowS
lowercase = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

-------------------------------------------------------------------------------
-- BuildReport
-------------------------------------------------------------------------------

data BuildReport = BuildReport {
    -- | The package this build report is about
    BuildReport -> PackageIdentifier
package         :: PackageIdentifier,

    -- | The OS and Arch the package was built on
    BuildReport -> OS
os              :: OS,
    BuildReport -> Arch
arch            :: Arch,

    -- | The Haskell compiler (and hopefully version) used
    BuildReport -> CompilerId
compiler        :: CompilerId,

    -- | The uploading client, ie cabal-install-x.y.z
    BuildReport -> PackageIdentifier
client          :: PackageIdentifier,

    -- | Which configurations flags we used
    BuildReport -> FlagAssignment
flagAssignment  :: FlagAssignment,

    -- | Which dependent packages we were using exactly
    BuildReport -> [PackageIdentifier]
dependencies    :: [PackageIdentifier],

    -- | Did installing work ok?
    BuildReport -> InstallOutcome
installOutcome  :: InstallOutcome,

    --   Which version of the Cabal library was used to compile the Setup.hs
--    cabalVersion    :: Version,

    --   Which build tools we were using (with versions)
--    tools      :: [PackageIdentifier],

    -- | Configure outcome, did configure work ok?
    BuildReport -> Outcome
docsOutcome     :: Outcome,

    -- | Configure outcome, did configure work ok?
    BuildReport -> Outcome
testsOutcome    :: Outcome
  }
  deriving (BuildReport -> BuildReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildReport -> BuildReport -> Bool
$c/= :: BuildReport -> BuildReport -> Bool
== :: BuildReport -> BuildReport -> Bool
$c== :: BuildReport -> BuildReport -> Bool
Eq, Int -> BuildReport -> ShowS
[BuildReport] -> ShowS
BuildReport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildReport] -> ShowS
$cshowList :: [BuildReport] -> ShowS
show :: BuildReport -> String
$cshow :: BuildReport -> String
showsPrec :: Int -> BuildReport -> ShowS
$cshowsPrec :: Int -> BuildReport -> ShowS
Show, forall x. Rep BuildReport x -> BuildReport
forall x. BuildReport -> Rep BuildReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuildReport x -> BuildReport
$cfrom :: forall x. BuildReport -> Rep BuildReport x
Generic)



-------------------------------------------------------------------------------
-- InstallOutcome
-------------------------------------------------------------------------------

data InstallOutcome
   = PlanningFailed
   | DependencyFailed PackageIdentifier
   | DownloadFailed
   | UnpackFailed
   | SetupFailed
   | ConfigureFailed
   | BuildFailed
   | TestsFailed
   | InstallFailed
   | InstallOk
  deriving (InstallOutcome -> InstallOutcome -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstallOutcome -> InstallOutcome -> Bool
$c/= :: InstallOutcome -> InstallOutcome -> Bool
== :: InstallOutcome -> InstallOutcome -> Bool
$c== :: InstallOutcome -> InstallOutcome -> Bool
Eq, Int -> InstallOutcome -> ShowS
[InstallOutcome] -> ShowS
InstallOutcome -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstallOutcome] -> ShowS
$cshowList :: [InstallOutcome] -> ShowS
show :: InstallOutcome -> String
$cshow :: InstallOutcome -> String
showsPrec :: Int -> InstallOutcome -> ShowS
$cshowsPrec :: Int -> InstallOutcome -> ShowS
Show, forall x. Rep InstallOutcome x -> InstallOutcome
forall x. InstallOutcome -> Rep InstallOutcome x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InstallOutcome x -> InstallOutcome
$cfrom :: forall x. InstallOutcome -> Rep InstallOutcome x
Generic)

instance Pretty InstallOutcome where
  pretty :: InstallOutcome -> Doc
pretty InstallOutcome
PlanningFailed  = String -> Doc
Disp.text String
"PlanningFailed"
  pretty (DependencyFailed PackageIdentifier
pkgid) = String -> Doc
Disp.text String
"DependencyFailed" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty PackageIdentifier
pkgid
  pretty InstallOutcome
DownloadFailed  = String -> Doc
Disp.text String
"DownloadFailed"
  pretty InstallOutcome
UnpackFailed    = String -> Doc
Disp.text String
"UnpackFailed"
  pretty InstallOutcome
SetupFailed     = String -> Doc
Disp.text String
"SetupFailed"
  pretty InstallOutcome
ConfigureFailed = String -> Doc
Disp.text String
"ConfigureFailed"
  pretty InstallOutcome
BuildFailed     = String -> Doc
Disp.text String
"BuildFailed"
  pretty InstallOutcome
TestsFailed     = String -> Doc
Disp.text String
"TestsFailed"
  pretty InstallOutcome
InstallFailed   = String -> Doc
Disp.text String
"InstallFailed"
  pretty InstallOutcome
InstallOk       = String -> Doc
Disp.text String
"InstallOk"

instance Parsec InstallOutcome where
  parsec :: forall (m :: * -> *). CabalParsing m => m InstallOutcome
parsec = do
    String
name <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlpha
    case String
name of
      String
"PlanningFailed"   -> forall (m :: * -> *) a. Monad m => a -> m a
return InstallOutcome
PlanningFailed
      String
"DependencyFailed" -> PackageIdentifier -> InstallOutcome
DependencyFailed forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => m ()
P.spaces forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
      String
"DownloadFailed"   -> forall (m :: * -> *) a. Monad m => a -> m a
return InstallOutcome
DownloadFailed
      String
"UnpackFailed"     -> forall (m :: * -> *) a. Monad m => a -> m a
return InstallOutcome
UnpackFailed
      String
"SetupFailed"      -> forall (m :: * -> *) a. Monad m => a -> m a
return InstallOutcome
SetupFailed
      String
"ConfigureFailed"  -> forall (m :: * -> *) a. Monad m => a -> m a
return InstallOutcome
ConfigureFailed
      String
"BuildFailed"      -> forall (m :: * -> *) a. Monad m => a -> m a
return InstallOutcome
BuildFailed
      String
"TestsFailed"      -> forall (m :: * -> *) a. Monad m => a -> m a
return InstallOutcome
TestsFailed
      String
"InstallFailed"    -> forall (m :: * -> *) a. Monad m => a -> m a
return InstallOutcome
InstallFailed
      String
"InstallOk"        -> forall (m :: * -> *) a. Monad m => a -> m a
return InstallOutcome
InstallOk
      String
_                  -> forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected forall a b. (a -> b) -> a -> b
$ String
"InstallOutcome: " forall a. [a] -> [a] -> [a]
++ String
name

-------------------------------------------------------------------------------
-- Outcome
-------------------------------------------------------------------------------

data Outcome = NotTried | Failed | Ok
  deriving (Outcome -> Outcome -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Outcome -> Outcome -> Bool
$c/= :: Outcome -> Outcome -> Bool
== :: Outcome -> Outcome -> Bool
$c== :: Outcome -> Outcome -> Bool
Eq, Int -> Outcome -> ShowS
[Outcome] -> ShowS
Outcome -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Outcome] -> ShowS
$cshowList :: [Outcome] -> ShowS
show :: Outcome -> String
$cshow :: Outcome -> String
showsPrec :: Int -> Outcome -> ShowS
$cshowsPrec :: Int -> Outcome -> ShowS
Show, Int -> Outcome
Outcome -> Int
Outcome -> [Outcome]
Outcome -> Outcome
Outcome -> Outcome -> [Outcome]
Outcome -> Outcome -> Outcome -> [Outcome]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Outcome -> Outcome -> Outcome -> [Outcome]
$cenumFromThenTo :: Outcome -> Outcome -> Outcome -> [Outcome]
enumFromTo :: Outcome -> Outcome -> [Outcome]
$cenumFromTo :: Outcome -> Outcome -> [Outcome]
enumFromThen :: Outcome -> Outcome -> [Outcome]
$cenumFromThen :: Outcome -> Outcome -> [Outcome]
enumFrom :: Outcome -> [Outcome]
$cenumFrom :: Outcome -> [Outcome]
fromEnum :: Outcome -> Int
$cfromEnum :: Outcome -> Int
toEnum :: Int -> Outcome
$ctoEnum :: Int -> Outcome
pred :: Outcome -> Outcome
$cpred :: Outcome -> Outcome
succ :: Outcome -> Outcome
$csucc :: Outcome -> Outcome
Enum, Outcome
forall a. a -> a -> Bounded a
maxBound :: Outcome
$cmaxBound :: Outcome
minBound :: Outcome
$cminBound :: Outcome
Bounded, forall x. Rep Outcome x -> Outcome
forall x. Outcome -> Rep Outcome x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Outcome x -> Outcome
$cfrom :: forall x. Outcome -> Rep Outcome x
Generic)

instance Pretty Outcome where
  pretty :: Outcome -> Doc
pretty Outcome
NotTried = String -> Doc
Disp.text String
"NotTried"
  pretty Outcome
Failed   = String -> Doc
Disp.text String
"Failed"
  pretty Outcome
Ok       = String -> Doc
Disp.text String
"Ok"

instance Parsec Outcome where
  parsec :: forall (m :: * -> *). CabalParsing m => m Outcome
parsec = do
    String
name <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlpha
    case String
name of
      String
"NotTried" -> forall (m :: * -> *) a. Monad m => a -> m a
return Outcome
NotTried
      String
"Failed"   -> forall (m :: * -> *) a. Monad m => a -> m a
return Outcome
Failed
      String
"Ok"       -> forall (m :: * -> *) a. Monad m => a -> m a
return Outcome
Ok
      String
_          -> forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected forall a b. (a -> b) -> a -> b
$ String
"Outcome: " forall a. [a] -> [a] -> [a]
++ String
name