Add instance Arbitrary PkgBuildReports_v4

Author: ysangkok

src/Distribution/Server/Features/BuildReports/BuildReport.hs

@@ -276,6 +276,16 @@ data BuildCovg = BuildCovg {
   topLevel          :: (Int,Int)
 } deriving (Eq, Typeable, Show)
 
+instance Arbitrary BuildCovg where
+  arbitrary =
+    BuildCovg
+      <$> intPair
+      <*> liftA3 BooleanCovg intPair intPair intPair
+      <*> intPair
+      <*> intPair
+      <*> intPair
+    where intPair = liftA2 (,) arbitrary arbitrary
+
 instance MemSize BuildCovg where
     memSize (BuildCovg a (BooleanCovg b c d) e f g) = memSize7 a b c d e f g
 
@@ -500,6 +510,10 @@ instance Arbitrary Outcome where
 
 data BuildStatus = BuildOK | BuildFailCnt Int
   deriving (Eq, Ord, Typeable, Show)
+
+instance Arbitrary BuildStatus where
+  arbitrary = oneof [ pure BuildOK, BuildFailCnt <$> arbitrary ]
+
 instance ToJSON BuildStatus where
   toJSON (BuildFailCnt a) = toJSON a
   toJSON BuildOK          = toJSON ((-1)::Int)

src/Distribution/Server/Features/BuildReports/BuildReports.hs

@@ -1,11 +1,10 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, TemplateHaskell,
              TypeFamilies #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 module Distribution.Server.Features.BuildReports.BuildReports (
     BuildReport(..),
     BuildReports(..),
-    BuildReports_v3,
     BuildReportId(..),
+    PkgBuildReports_v4(..),
     PkgBuildReports(..),
     BuildLog(..),
     TestLog(..),
@@ -55,12 +54,13 @@ import Data.Typeable (Typeable)
 import qualified Data.List as L
 import qualified Data.Char as Char
 import Data.Maybe (fromMaybe)
+import Test.QuickCheck (Arbitrary(..))
 
 import Text.StringTemplate (ToSElem(..))
 
 
 newtype BuildReportId = BuildReportId Int
-  deriving (Eq, Ord, Typeable, Show, MemSize, Pretty)
+  deriving (Eq, Ord, Typeable, Show, MemSize, Pretty, Arbitrary)
 
 incrementReportId :: BuildReportId -> BuildReportId
 incrementReportId (BuildReportId n) = BuildReportId (n+1)
@@ -82,10 +82,10 @@ instance Parsec BuildReportId where
       f c = Char.ord c - Char.ord '0'
 
 newtype BuildLog = BuildLog BlobStorage.BlobId
-  deriving (Eq, Typeable, Show, MemSize)
+  deriving (Eq, Typeable, Show, MemSize, Arbitrary)
 
 newtype TestLog = TestLog BlobStorage.BlobId
-  deriving (Eq, Typeable, Show, MemSize)
+  deriving (Eq, Typeable, Show, MemSize, Arbitrary)
 
 newtype TestReportLog = TestReportLog BlobStorage.BlobId
   deriving (Eq, Typeable, Show, MemSize)
@@ -307,6 +307,10 @@ data PkgBuildReports_v4 = PkgBuildReports_v4 {
     runTests_v4     :: !Bool
 } deriving (Eq, Typeable, Show)
 
+instance Arbitrary PkgBuildReports_v4 where
+  arbitrary = PkgBuildReports_v4 <$> arbitrary <*> arbitrary
+                                 <*> arbitrary <*> arbitrary
+
 instance SafeCopy PkgBuildReports_v4 where
     version = 4
     kind    = extension

src/Distribution/Server/Features/Security/MD5.hs

@@ -27,6 +27,7 @@ import qualified Data.ByteString.Char8                 as BS.Char8
 import qualified Data.ByteString.Lazy                  as BS.Lazy
 import           Data.SafeCopy
 import qualified Data.Serialize                        as Ser
+import           Test.QuickCheck (Arbitrary(..))
 
 -- cryptohash
 import qualified Crypto.Hash.MD5                       as MD5
@@ -39,6 +40,9 @@ import           Distribution.Server.Util.ReadDigest
 data MD5Digest = MD5Digest {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
                deriving (Eq,Ord)
 
+instance Arbitrary MD5Digest where
+  arbitrary = MD5Digest <$> arbitrary <*> arbitrary
+
 instance NFData MD5Digest where
     rnf !_ = () -- 'MD5Digest' has only strict primitive fields, hence WHNF==NF
 

src/Distribution/Server/Framework/BlobStorage.hs

@@ -53,6 +53,7 @@ import System.Directory
 import System.IO
 import Data.Aeson
 import System.Posix.Files as Posix (createLink)
+import Test.QuickCheck (Arbitrary)
 
 -- For fsync
 import System.Posix.Types (Fd(..))
@@ -71,7 +72,7 @@ import System.Posix.IO (
 -- | An id for a blob. The content of the blob is stable.
 --
 newtype BlobId = BlobId MD5Digest
-  deriving (Eq, Ord, Show, Typeable, MemSize)
+  deriving (Eq, Ord, Show, Typeable, MemSize, Arbitrary)
 
 instance ToJSON BlobId where
   toJSON = toJSON . blobMd5