Re: [PATCH master 20/40] Change the Luxi tags kind from String to a custom type

[Agata Murawska]

On Tue, Aug 21, 2012 at 3:06 PM, Iustin Pop <ius...@google.com> wrote:
>
> This will allow safer code when we implement the tags query.
>
> Signed-off-by: Iustin Pop <ius...@google.com>
> ---
>  htools/Ganeti/HTools/QC.hs |    5 ++++-
>  htools/Ganeti/Luxi.hs      |   12 +++++++++++-
>  2 files changed, 15 insertions(+), 2 deletions(-)
>
> diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
> index 21fbf59..6a19a2b 100644
> --- a/htools/Ganeti/HTools/QC.hs
> +++ b/htools/Ganeti/HTools/QC.hs
> @@ -1824,6 +1824,9 @@ testSuite "JSON"
>
>  -- * Luxi tests
>
> +instance Arbitrary Luxi.TagObject where
> +  arbitrary = elements [minBound..maxBound]
> +
>  instance Arbitrary Luxi.LuxiReq where
>    arbitrary = elements [minBound..maxBound]
>
> @@ -1843,7 +1846,7 @@ instance Arbitrary Luxi.LuxiOp where
>                                (listOf getFQDN) <*> arbitrary
>        Luxi.ReqQueryConfigValues -> Luxi.QueryConfigValues <$> getFields
>        Luxi.ReqQueryClusterInfo -> pure Luxi.QueryClusterInfo
> -      Luxi.ReqQueryTags -> Luxi.QueryTags <$> getName <*> getFQDN
> +      Luxi.ReqQueryTags -> Luxi.QueryTags <$> arbitrary <*> getFQDN
>        Luxi.ReqSubmitJob -> Luxi.SubmitJob <$> (resize maxOpCodes arbitrary)
>        Luxi.ReqSubmitManyJobs -> Luxi.SubmitManyJobs <$>
>                                  (resize maxOpCodes arbitrary)
> diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs
> index 939302c..0ac40e7 100644
> --- a/htools/Ganeti/Luxi.hs
> +++ b/htools/Ganeti/Luxi.hs
> @@ -32,6 +32,7 @@ module Ganeti.Luxi
>    , Client
>    , JobId
>    , RecvResult(..)
> +  , TagObject(..)
>    , strOfOp
>    , checkRS
>    , getClient
> @@ -99,6 +100,15 @@ data RecvResult = RecvConnClosed    -- ^ Connection closed
>  -- | The Ganeti job type.
>  type JobId = Int
>
> +-- | Data type representing what items do the tag operations apply to.
> +$(declareSADT "TagObject"
> +  [ ("TagInstance", 'tagInstance)
> +  , ("TagNode",     'tagNode)
> +  , ("TagGroup",    'tagNodegroup)
> +  , ("TagCluster",  'tagCluster)
> +  ])
> +$(makeJSONInstance ''TagObject)
> +
>  -- | Currently supported Luxi operations and JSON serialization.
>  $(genLuxiOp "LuxiOp"
>    [(luxiReqQuery,
> @@ -134,7 +144,7 @@ $(genLuxiOp "LuxiOp"
>      )
>    , (luxiReqQueryClusterInfo, [])
>    , (luxiReqQueryTags,
> -     [ ("kind", [t| String |])
> +     [ ("kind", [t| TagObject |])
>       , ("name", [t| String |])
>       ])
>    , (luxiReqSubmitJob,
> --
> 1.7.7.3
>

LGTM