diff --git a/src/Ganeti/Types.hs b/src/Ganeti/Types.hs index e6c9378e1682dbec62343c1e375a1c5d0c9e0ff7..9f02173a0aea541c62181ea70c3e7d732c5d6ad8 100644 --- a/src/Ganeti/Types.hs +++ b/src/Ganeti/Types.hs @@ -11,7 +11,7 @@ representation should go into 'Ganeti.HTools.Types'. {- -Copyright (C) 2012 Google Inc. +Copyright (C) 2012, 2013 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 @@ -86,6 +86,8 @@ module Ganeti.Types , JobDependency(..) , OpSubmitPriority(..) , opSubmitPriorityToRaw + , parseSubmitPriority + , fmtSubmitPriority , OpStatus(..) , opStatusToRaw , opStatusFromRaw @@ -447,6 +449,19 @@ $(THH.declareIADT "OpSubmitPriority" ]) $(THH.makeJSONInstance ''OpSubmitPriority) +-- | Parse submit priorities from a string. +parseSubmitPriority :: (Monad m) => String -> m OpSubmitPriority +parseSubmitPriority "low" = return OpPrioLow +parseSubmitPriority "normal" = return OpPrioNormal +parseSubmitPriority "high" = return OpPrioHigh +parseSubmitPriority str = fail $ "Unknown priority '" ++ str ++ "'" + +-- | Format a submit priority as string. +fmtSubmitPriority :: OpSubmitPriority -> String +fmtSubmitPriority OpPrioLow = "low" +fmtSubmitPriority OpPrioNormal = "normal" +fmtSubmitPriority OpPrioHigh = "high" + -- | Our ADT for the OpCode status at runtime (while in a job). $(THH.declareSADT "OpStatus" [ ("OP_STATUS_QUEUED", 'C.opStatusQueued) diff --git a/test/hs/Test/Ganeti/Types.hs b/test/hs/Test/Ganeti/Types.hs index 6f84782cac602a30078963032f5392db3a2ec83c..6246e6e0cde5fb2e1ae573dce758b7cf285c51f6 100644 --- a/test/hs/Test/Ganeti/Types.hs +++ b/test/hs/Test/Ganeti/Types.hs @@ -7,7 +7,7 @@ {- -Copyright (C) 2012 Google Inc. +Copyright (C) 2012, 2013 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 @@ -370,6 +370,11 @@ prop_JobDependency_serialisation = testSerialisation prop_OpSubmitPriority_serialisation :: OpSubmitPriority -> Property prop_OpSubmitPriority_serialisation = testSerialisation +-- | Tests string formatting for 'OpSubmitPriority'. +prop_OpSubmitPriority_string :: OpSubmitPriority -> Property +prop_OpSubmitPriority_string prio = + parseSubmitPriority (fmtSubmitPriority prio) ==? Just prio + -- | Test 'ELogType' serialisation. prop_ELogType_serialisation :: ELogType -> Property prop_ELogType_serialisation = testSerialisation @@ -416,5 +421,6 @@ testSuite "Types" , 'case_JobId_BadTypes , 'prop_JobDependency_serialisation , 'prop_OpSubmitPriority_serialisation + , 'prop_OpSubmitPriority_string , 'prop_ELogType_serialisation ]