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>

diff --git a/src/Ganeti/OpCodes.hs b/src/Ganeti/OpCodes.hs
index 6f28445..3b30350 100644 (file)
--- 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 51d47b2..e445aa9 100644 (file)
--- 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 1183741..6044322 100644 (file)
--- 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