From a35a4f52c2ce4beb45e20bb5736f7e8ecbb0c29c Mon Sep 17 00:00:00 2001 From: Klaus Aehlig Date: Tue, 22 Apr 2014 15:56:01 +0200 Subject: [PATCH] Move the definition of JQueue objects to a separate file Move all the definition of objects to a spearate file. In this way, the lense module for JQueue can use these objects, while JQueue can use the lenses. For use outside, we reexport the objects. Signed-off-by: Klaus Aehlig Reviewed-by: Petr Pudlak --- Makefile.am | 2 + src/Ganeti/JQueue.hs | 63 +++---------------------- src/Ganeti/JQueue/Objects.hs | 91 ++++++++++++++++++++++++++++++++++++ 3 files changed, 100 insertions(+), 56 deletions(-) create mode 100644 src/Ganeti/JQueue/Objects.hs diff --git a/Makefile.am b/Makefile.am index acbf46630..0b329ab2c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -128,6 +128,7 @@ HS_DIRS = \ src/Ganeti/HTools/Program \ src/Ganeti/Hypervisor \ src/Ganeti/Hypervisor/Xen \ + src/Ganeti/JQueue \ src/Ganeti/Locking \ src/Ganeti/Logging \ src/Ganeti/Monitoring \ @@ -776,6 +777,7 @@ HS_LIB_SRCS = \ src/Ganeti/Hs2Py/GenOpCodes.hs \ src/Ganeti/Hs2Py/OpDoc.hs \ src/Ganeti/JQueue.hs \ + src/Ganeti/JQueue/Objects.hs \ src/Ganeti/JQScheduler.hs \ src/Ganeti/JSON.hs \ src/Ganeti/Jobs.hs \ diff --git a/src/Ganeti/JQueue.hs b/src/Ganeti/JQueue.hs index 91ca0b4f0..ad6c8d190 100644 --- a/src/Ganeti/JQueue.hs +++ b/src/Ganeti/JQueue.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} - {-| Implementation of the job queue. -} @@ -26,16 +24,12 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} module Ganeti.JQueue - ( QueuedOpCode(..) - , QueuedJob(..) - , InputOpCode(..) - , queuedOpCodeFromMetaOpCode + ( queuedOpCodeFromMetaOpCode , queuedJobFromOpCodes , changeOpCodePriority , changeJobPriority , cancelQueuedJob , failQueuedJob - , Timestamp , fromClockTime , noTimestamp , currentTimestamp @@ -70,6 +64,11 @@ module Ganeti.JQueue , cancelJob , queueDirPermissions , archiveJobs + -- re-export + , Timestamp + , InputOpCode(..) + , QueuedOpCode(..) + , QueuedJob(..) ) where import Control.Applicative (liftA2, (<|>)) @@ -100,6 +99,7 @@ import Ganeti.BasicTypes import qualified Ganeti.Config as Config import qualified Ganeti.Constants as C import Ganeti.Errors (ErrorResult, ResultG) +import Ganeti.JQueue.Objects import Ganeti.JSON import Ganeti.Logging import Ganeti.Luxi @@ -109,8 +109,6 @@ import Ganeti.Path import Ganeti.Query.Exec as Exec import Ganeti.Rpc (executeRpcCall, ERpcError, logRpcErrors, RpcCallJobqueueUpdate(..), RpcCallJobqueueRename(..)) -import Ganeti.THH -import Ganeti.THH.Field import Ganeti.Types import Ganeti.Utils import Ganeti.Utils.Atomic @@ -119,11 +117,6 @@ import Ganeti.VCluster (makeVirtualPath) -- * Data types --- | The ganeti queue timestamp type. It represents the time as the pair --- of seconds since the epoch and microseconds since the beginning of the --- second. -type Timestamp = (Int, Int) - -- | Missing timestamp type. noTimestamp :: Timestamp noTimestamp = (-1, -1) @@ -142,25 +135,12 @@ currentTimestamp = fromClockTime `liftM` getClockTime advanceTimestamp :: Int -> Timestamp -> Timestamp advanceTimestamp = first . (+) --- | An input opcode. -data InputOpCode = ValidOpCode MetaOpCode -- ^ OpCode was parsed successfully - | InvalidOpCode JSValue -- ^ Invalid opcode - deriving (Show, Eq) -- | From an InputOpCode obtain the MetaOpCode, if any. toMetaOpCode :: InputOpCode -> [MetaOpCode] toMetaOpCode (ValidOpCode mopc) = [mopc] toMetaOpCode _ = [] --- | JSON instance for 'InputOpCode', trying to parse it and if --- failing, keeping the original JSValue. -instance Text.JSON.JSON InputOpCode where - showJSON (ValidOpCode mo) = Text.JSON.showJSON mo - showJSON (InvalidOpCode inv) = inv - readJSON v = case Text.JSON.readJSON v of - Text.JSON.Error _ -> return $ InvalidOpCode v - Text.JSON.Ok mo -> return $ ValidOpCode mo - -- | Invalid opcode summary. invalidOp :: String invalidOp = "INVALID_OP" @@ -176,35 +156,6 @@ extractOpSummary (InvalidOpCode (JSObject o)) = Nothing -> invalidOp extractOpSummary _ = invalidOp -$(buildObject "QueuedOpCode" "qo" - [ simpleField "input" [t| InputOpCode |] - , simpleField "status" [t| OpStatus |] - , simpleField "result" [t| JSValue |] - , defaultField [| [] |] $ - simpleField "log" [t| [(Int, Timestamp, ELogType, JSValue)] |] - , simpleField "priority" [t| Int |] - , optionalNullSerField $ - simpleField "start_timestamp" [t| Timestamp |] - , optionalNullSerField $ - simpleField "exec_timestamp" [t| Timestamp |] - , optionalNullSerField $ - simpleField "end_timestamp" [t| Timestamp |] - ]) - -$(buildObject "QueuedJob" "qj" - [ simpleField "id" [t| JobId |] - , simpleField "ops" [t| [QueuedOpCode] |] - , optionalNullSerField $ - simpleField "received_timestamp" [t| Timestamp |] - , optionalNullSerField $ - simpleField "start_timestamp" [t| Timestamp |] - , optionalNullSerField $ - simpleField "end_timestamp" [t| Timestamp |] - , optionalField $ - simpleField "livelock" [t| FilePath |] - , optionalField $ processIdField "process_id" - ]) - -- | Convenience function to obtain a QueuedOpCode from a MetaOpCode queuedOpCodeFromMetaOpCode :: MetaOpCode -> QueuedOpCode queuedOpCodeFromMetaOpCode op = diff --git a/src/Ganeti/JQueue/Objects.hs b/src/Ganeti/JQueue/Objects.hs new file mode 100644 index 000000000..8308faa47 --- /dev/null +++ b/src/Ganeti/JQueue/Objects.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE TemplateHaskell #-} + +{-| Objects in the job queue. + +-} + +{- + +Copyright (C) 2014 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 +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +-} + +module Ganeti.JQueue.Objects + ( Timestamp + , InputOpCode(..) + , QueuedOpCode(..) + , QueuedJob(..) + ) where + +import Prelude hiding (id, log) +import qualified Text.JSON +import Text.JSON.Types + +import Ganeti.THH +import Ganeti.THH.Field +import Ganeti.Types +import Ganeti.OpCodes + +-- | The ganeti queue timestamp type. It represents the time as the pair +-- of seconds since the epoch and microseconds since the beginning of the +-- second. +type Timestamp = (Int, Int) + +-- | An input opcode. +data InputOpCode = ValidOpCode MetaOpCode -- ^ OpCode was parsed successfully + | InvalidOpCode JSValue -- ^ Invalid opcode + deriving (Show, Eq) + +-- | JSON instance for 'InputOpCode', trying to parse it and if +-- failing, keeping the original JSValue. +instance Text.JSON.JSON InputOpCode where + showJSON (ValidOpCode mo) = Text.JSON.showJSON mo + showJSON (InvalidOpCode inv) = inv + readJSON v = case Text.JSON.readJSON v of + Text.JSON.Error _ -> return $ InvalidOpCode v + Text.JSON.Ok mo -> return $ ValidOpCode mo + +$(buildObject "QueuedOpCode" "qo" + [ simpleField "input" [t| InputOpCode |] + , simpleField "status" [t| OpStatus |] + , simpleField "result" [t| JSValue |] + , defaultField [| [] |] $ + simpleField "log" [t| [(Int, Timestamp, ELogType, JSValue)] |] + , simpleField "priority" [t| Int |] + , optionalNullSerField $ + simpleField "start_timestamp" [t| Timestamp |] + , optionalNullSerField $ + simpleField "exec_timestamp" [t| Timestamp |] + , optionalNullSerField $ + simpleField "end_timestamp" [t| Timestamp |] + ]) + +$(buildObject "QueuedJob" "qj" + [ simpleField "id" [t| JobId |] + , simpleField "ops" [t| [QueuedOpCode] |] + , optionalNullSerField $ + simpleField "received_timestamp" [t| Timestamp |] + , optionalNullSerField $ + simpleField "start_timestamp" [t| Timestamp |] + , optionalNullSerField $ + simpleField "end_timestamp" [t| Timestamp |] + , optionalField $ + simpleField "livelock" [t| FilePath |] + , optionalField $ processIdField "process_id" + ]) + -- GitLab