From 516a0e94f37467bcc3baf8c15fc761caade40e0d Mon Sep 17 00:00:00 2001
From: Michele Tartara <mtartara@google.com>
Date: Thu, 25 Apr 2013 07:19:49 +0000
Subject: [PATCH] Add reason trail to haskell opcode format
The haskell type definition of opcodes should remain aligned with the python
one.
Signed-off-by: Michele Tartara <mtartara@google.com>
Reviewed-by: Helga Velroyen <helgav@google.com>
---
src/Ganeti/OpCodes.hs | 2 ++
src/Ganeti/OpParams.hs | 5 +++++
test/hs/Test/Ganeti/OpCodes.hs | 13 ++++++++++++-
3 files changed, 19 insertions(+), 1 deletion(-)
diff --git a/src/Ganeti/OpCodes.hs b/src/Ganeti/OpCodes.hs
index 6f2844544..3b3035099 100644
--- a/src/Ganeti/OpCodes.hs
+++ b/src/Ganeti/OpCodes.hs
@@ -626,6 +626,7 @@ $(buildObject "CommonOpParams" "op"
, pOpPriority
, pDependencies
, pComment
+ , pReason
])
-- | Default common parameter values.
@@ -636,6 +637,7 @@ defOpParams =
, opPriority = OpPrioNormal
, opDepends = Nothing
, opComment = Nothing
+ , opReason = []
}
-- | The top-level opcode type.
diff --git a/src/Ganeti/OpParams.hs b/src/Ganeti/OpParams.hs
index 51d47b252..e445aa974 100644
--- a/src/Ganeti/OpParams.hs
+++ b/src/Ganeti/OpParams.hs
@@ -236,6 +236,7 @@ module Ganeti.OpParams
, pOpPriority
, pDependencies
, pComment
+ , pReason
, pEnabledDiskTemplates
, dOldQuery
, dOldQueryNoLocking
@@ -1444,6 +1445,10 @@ pDependencies =
pComment :: Field
pComment = optionalNullSerField $ stringField "comment"
+-- | Reason trail field.
+pReason :: Field
+pReason = simpleField C.opcodeReason [t| ReasonTrail |]
+
-- * Entire opcode parameter list
-- | Old-style query opcode, with locking.
diff --git a/test/hs/Test/Ganeti/OpCodes.hs b/test/hs/Test/Ganeti/OpCodes.hs
index 118374142..6044322fe 100644
--- a/test/hs/Test/Ganeti/OpCodes.hs
+++ b/test/hs/Test/Ganeti/OpCodes.hs
@@ -342,9 +342,20 @@ instance Arbitrary OpCodes.OpCode where
genNameNE
_ -> fail $ "Undefined arbitrary for opcode " ++ op_id
+-- | Generates one element of a reason trail
+genReasonElem :: Gen ReasonElem
+genReasonElem = (,,) <$> genFQDN <*> genFQDN <*> arbitrary
+
+-- | Generates a reason trail
+genReasonTrail :: Gen ReasonTrail
+genReasonTrail = do
+ size <- choose (0, 10)
+ vectorOf size genReasonElem
+
instance Arbitrary OpCodes.CommonOpParams where
arbitrary = OpCodes.CommonOpParams <$> arbitrary <*> arbitrary <*>
- arbitrary <*> resize 5 arbitrary <*> genMaybe genName
+ arbitrary <*> resize 5 arbitrary <*> genMaybe genName <*>
+ genReasonTrail
-- * Helper functions
--
GitLab