module Ganeti.Hypervisor.Xen.Types
( LispConfig(..)
, Domain(..)
, FromLispConfig(..)
, UptimeInfo(..)
, ActualState(..)
) where
import qualified Text.JSON as J
import Ganeti.BasicTypes
data LispConfig = LCList [LispConfig]
| LCString String
| LCDouble Double
deriving (Eq, Show)
data Domain = Domain
{ domId :: Int
, domName :: String
, domCpuTime :: Double
, domState :: ActualState
, domIsHung :: Maybe Bool
} deriving (Show, Eq)
class FromLispConfig a where
fromLispConfig :: LispConfig -> Result a
instance FromLispConfig Int where
fromLispConfig (LCDouble d) = Ok $ floor d
fromLispConfig (LCList [LCString _, LCDouble d]) = Ok $ floor d
fromLispConfig c =
Bad $ "Unable to extract a Int from this configuration: "
++ show c
instance FromLispConfig Double where
fromLispConfig (LCDouble d) = Ok d
fromLispConfig (LCList [LCString _, LCDouble d]) = Ok d
fromLispConfig c =
Bad $ "Unable to extract a Double from this configuration: "
++ show c
instance FromLispConfig String where
fromLispConfig (LCString s) = Ok s
fromLispConfig (LCList [LCString _, LCString s]) = Ok s
fromLispConfig c =
Bad $ "Unable to extract a String from this configuration: "
++ show c
instance FromLispConfig [LispConfig] where
fromLispConfig (LCList l) = Ok l
fromLispConfig c =
Bad $ "Unable to extract a List from this configuration: "
++ show c
data UptimeInfo = UptimeInfo
{ uInfoName :: String
, uInfoID :: Int
, uInfoUptime :: String
} deriving (Eq, Show)
data ActualState = ActualRunning
| ActualBlocked
| ActualPaused
| ActualShutdown
| ActualCrashed
| ActualDying
| ActualHung
| ActualUnknown
deriving (Show, Eq)
instance J.JSON ActualState where
showJSON ActualRunning = J.showJSON "running"
showJSON ActualBlocked = J.showJSON "blocked"
showJSON ActualPaused = J.showJSON "paused"
showJSON ActualShutdown = J.showJSON "shutdown"
showJSON ActualCrashed = J.showJSON "crashed"
showJSON ActualDying = J.showJSON "dying"
showJSON ActualHung = J.showJSON "hung"
showJSON ActualUnknown = J.showJSON "unknown"
readJSON = error "JSON read instance not implemented for type ActualState"