Commit 4651c69f authored by Jose A. Lopes's avatar Jose A. Lopes
Browse files

Wrap 'Set' in 'ListSet' for the opcodes



In what Haskell to Python opcodes are concerned, a Haskell 'Set' is
translated into a Python 'list'.  In other words, currently, opcodes
that handle sets of parameters are actually handling lists because
this is how sets are currently encoded.  This patch introduces a new
type called 'ListSet' that wraps a Haskell 'Set' and it is used to
represent on the Haskell side a Python 'list' without duplicate
elements.  This patch also updates the respective opcode parameters
and updates the opcode tests.
Signed-off-by: default avatarJose A. Lopes <jabolopes@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent 3a933ed8
......@@ -41,6 +41,8 @@ module Ganeti.BasicTypes
, goodMatchPriority
, prefixMatch
, compareNameComponent
, ListSet(..)
, emptyListSet
) where
import Control.Applicative
......@@ -48,6 +50,10 @@ import Control.Monad
import Control.Monad.Trans
import Data.Function
import Data.List
import Data.Set (Set)
import qualified Data.Set as Set (empty)
import Text.JSON (JSON)
import qualified Text.JSON as JSON (readJSON, showJSON)
-- | Generic monad for our error handling mechanisms.
data GenericResult a b
......@@ -224,3 +230,18 @@ lookupName :: [String] -- ^ List of keys
-> LookupResult -- ^ Result of the lookup
lookupName l s = foldr (chooseLookupResult s)
(LookupResult FailMatch s) l
-- | Wrapper for a Haskell 'Set'
--
-- This type wraps a 'Set' and it is used in the Haskell to Python
-- opcode generation to transform a Haskell 'Set' into a Python 'list'
-- without duplicate elements.
newtype ListSet a = ListSet { unListSet :: Set a }
deriving (Eq, Show)
instance (Ord a, JSON a) => JSON (ListSet a) where
showJSON = JSON.showJSON . unListSet
readJSON = liftM ListSet . JSON.readJSON
emptyListSet :: ListSet a
emptyListSet = ListSet Set.empty
......@@ -252,8 +252,6 @@ module Ganeti.OpParams
) where
import Control.Monad (liftM)
import Data.Set (Set)
import qualified Data.Set as Set
import Text.JSON (JSON, JSValue(..), JSObject (..), readJSON, showJSON,
fromJSString, toJSObject)
import qualified Text.JSON
......@@ -266,7 +264,6 @@ import Ganeti.JSON
import Ganeti.Types
import qualified Ganeti.Query.Language as Qlang
-- * Helper functions and types
-- | Build a boolean field.
......@@ -448,7 +445,6 @@ instance JSON ExportTarget where
showJSON (ExportTargetRemote l) = showJSON l
readJSON = readExportTarget
-- * Common opcode parameters
pDryRun :: Field
......@@ -483,7 +479,6 @@ pReason =
withDoc "Reason trail field" $
simpleField C.opcodeReason [t| ReasonTrail |]
-- * Parameters
pDebugSimulateErrors :: Field
......@@ -499,14 +494,14 @@ pErrorCodes =
pSkipChecks :: Field
pSkipChecks =
withDoc "Which checks to skip" .
defaultField [| Set.empty |] $
simpleField "skip_checks" [t| Set VerifyOptionalChecks |]
defaultField [| emptyListSet |] $
simpleField "skip_checks" [t| ListSet VerifyOptionalChecks |]
pIgnoreErrors :: Field
pIgnoreErrors =
withDoc "List of error codes that should be treated as warnings" .
defaultField [| Set.empty |] $
simpleField "ignore_errors" [t| Set CVErrorCode |]
defaultField [| emptyListSet |] $
simpleField "ignore_errors" [t| ListSet CVErrorCode |]
pVerbose :: Field
pVerbose =
......
......@@ -35,9 +35,9 @@ module Ganeti.PyValueInstances where
import Data.List (intercalate)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Set as Set (toList)
import Ganeti.BasicTypes
import Ganeti.THH
instance PyValue Bool
......@@ -59,5 +59,5 @@ instance (PyValue k, PyValue a) => PyValue (Map k a) where
"{" ++ intercalate ", " (map showPair (Map.assocs mp)) ++ "}"
where showPair (k, x) = show k ++ ":" ++ show x
instance PyValue a => PyValue (Set a) where
showValue s = showValue (Set.toList s)
instance PyValue a => PyValue (ListSet a) where
showValue = showValue . Set.toList . unListSet
......@@ -578,6 +578,7 @@ pyTypeName name =
"()" -> "None"
"Map" -> "DictOf"
"Set" -> "SetOf"
"ListSet" -> "SetOf"
"Either" -> "Or"
"GenericContainer" -> "DictOf"
"JSValue" -> "Any"
......
......@@ -149,14 +149,14 @@ instance Arbitrary OpCodes.OpCode where
"OP_CLUSTER_QUERY" -> pure OpCodes.OpClusterQuery
"OP_CLUSTER_VERIFY" ->
OpCodes.OpClusterVerify <$> arbitrary <*> arbitrary <*>
genSet Nothing <*> genSet Nothing <*> arbitrary <*>
genListSet Nothing <*> genListSet Nothing <*> arbitrary <*>
genMaybe genNameNE
"OP_CLUSTER_VERIFY_CONFIG" ->
OpCodes.OpClusterVerifyConfig <$> arbitrary <*> arbitrary <*>
genSet Nothing <*> arbitrary
genListSet Nothing <*> arbitrary
"OP_CLUSTER_VERIFY_GROUP" ->
OpCodes.OpClusterVerifyGroup <$> genNameNE <*> arbitrary <*>
arbitrary <*> genSet Nothing <*> genSet Nothing <*> arbitrary
arbitrary <*> genListSet Nothing <*> genListSet Nothing <*> arbitrary
"OP_CLUSTER_VERIFY_DISKS" -> pure OpCodes.OpClusterVerifyDisks
"OP_GROUP_VERIFY_DISKS" ->
OpCodes.OpGroupVerifyDisks <$> genNameNE
......
......@@ -50,6 +50,7 @@ module Test.Ganeti.TestCommon
, SmallRatio(..)
, genSetHelper
, genSet
, genListSet
, genIPv4Address
, genIPv4Network
, genIp6Addr
......@@ -279,10 +280,15 @@ genSetHelper candidates size = do
newelem <- elements candidates `suchThat` (`Set.notMember` set)
return (Set.insert newelem set)) Set.empty [1..size']
-- | Generates a set of arbitrary elements.
-- | Generates a 'Set' of arbitrary elements.
genSet :: (Ord a, Bounded a, Enum a) => Maybe Int -> Gen (Set.Set a)
genSet = genSetHelper [minBound..maxBound]
-- | Generates a 'Set' of arbitrary elements wrapped in a 'ListSet'
genListSet :: (Ord a, Bounded a, Enum a) => Maybe Int
-> Gen (BasicTypes.ListSet a)
genListSet is = BasicTypes.ListSet <$> genSet is
-- | Generate an arbitrary IPv4 address in textual form.
genIPv4 :: Gen String
genIPv4 = do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment