Cleanup HTools.Types/BasicTypes imports

[ganeti-local] / htools / Ganeti / OpCodes.hs

diff --git a/htools/Ganeti/OpCodes.hs b/htools/Ganeti/OpCodes.hs
index 4b54e21..566c5db 100644 (file)
--- a/htools/Ganeti/OpCodes.hs
+++ b/htools/Ganeti/OpCodes.hs
@@ -6,7 +6,7 @@
 
 {-
 
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -28,16 +28,19 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 module Ganeti.OpCodes
   ( OpCode(..)
   , ReplaceDisksMode(..)
+  , DiskIndex
+  , mkDiskIndex
+  , unDiskIndex
   , opID
+  , allOpIDs
   ) where
 
 import Text.JSON (readJSON, showJSON, makeObj, JSON)
-import qualified Text.JSON as J
 
 import qualified Ganeti.Constants as C
 import Ganeti.THH
 
-import Ganeti.HTools.Utils
+import Ganeti.JSON
 
 -- | Replace disks type.
 $(declareSADT "ReplaceDisksMode"
@@ -48,39 +51,59 @@ $(declareSADT "ReplaceDisksMode"
   ])
 $(makeJSONInstance ''ReplaceDisksMode)
 
+-- | Disk index type (embedding constraints on the index value via a
+-- smart constructor).
+newtype DiskIndex = DiskIndex { unDiskIndex :: Int }
+  deriving (Show, Read, Eq, Ord)
+
+-- | Smart constructor for 'DiskIndex'.
+mkDiskIndex :: (Monad m) => Int -> m DiskIndex
+mkDiskIndex i | i >= 0 && i < C.maxDisks = return (DiskIndex i)
+              | otherwise = fail $ "Invalid value for disk index '" ++
+                            show i ++ "', required between 0 and " ++
+                            show C.maxDisks
+
+instance JSON DiskIndex where
+  readJSON v = readJSON v >>= mkDiskIndex
+  showJSON = showJSON . unDiskIndex
+
 -- | OpCode representation.
 --
 -- We only implement a subset of Ganeti opcodes, but only what we
 -- actually use in the htools codebase.
 $(genOpCode "OpCode"
   [ ("OpTestDelay",
-     [ ("duration",  [t| Double   |], noDefault)
-     , ("on_master", [t| Bool     |], noDefault)
-     , ("on_nodes",  [t| [String] |], noDefault)
+     [ simpleField "duration"  [t| Double   |]
+     , simpleField "on_master" [t| Bool     |]
+     , simpleField "on_nodes"  [t| [String] |]
      ])
   , ("OpInstanceReplaceDisks",
-     [ ("instance_name", [t| String           |], noDefault)
-     , ("remote_node",   [t| Maybe String     |], noDefault)
-     , ("mode",          [t| ReplaceDisksMode |], noDefault)
-     , ("disks",         [t| [Int]            |], noDefault)
-     , ("iallocator",    [t| Maybe String     |], noDefault)
+     [ simpleField "instance_name" [t| String |]
+     , optionalField $ simpleField "remote_node" [t| String |]
+     , simpleField "mode"  [t| ReplaceDisksMode |]
+     , simpleField "disks" [t| [DiskIndex] |]
+     , optionalField $ simpleField "iallocator" [t| String |]
      ])
   , ("OpInstanceFailover",
-     [ ("instance_name",      [t| String       |], noDefault)
-     , ("ignore_consistency", [t| Bool         |], noDefault)
-     , ("target_node",        [t| Maybe String |], noDefault)
+     [ simpleField "instance_name"      [t| String |]
+     , simpleField "ignore_consistency" [t| Bool   |]
+     , optionalField $ simpleField "target_node" [t| String |]
      ])
   , ("OpInstanceMigrate",
-     [ ("instance_name",  [t| String       |], noDefault)
-     , ("live",           [t| Bool         |], noDefault)
-     , ("cleanup",        [t| Bool         |], noDefault)
-     , ("allow_failover", [t| Bool         |], [| Just False |])
-     , ("target_node",    [t| Maybe String |], noDefault)
+     [ simpleField "instance_name"  [t| String |]
+     , simpleField "live"           [t| Bool   |]
+     , simpleField "cleanup"        [t| Bool   |]
+     , defaultField [| False |] $ simpleField "allow_failover" [t| Bool |]
+     , optionalField $ simpleField "target_node" [t| String |]
      ])
   ])
 
+-- | Returns the OP_ID for a given opcode value.
 $(genOpID ''OpCode "opID")
 
+-- | A list of all defined/supported opcode IDs.
+$(genAllOpIDs ''OpCode "allOpIDs")
+
 instance JSON OpCode where
   readJSON = loadOpCode
   showJSON = saveOpCode