From a35a4f52c2ce4beb45e20bb5736f7e8ecbb0c29c Mon Sep 17 00:00:00 2001
From: Klaus Aehlig <aehlig@google.com>
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 <aehlig@google.com>
Reviewed-by: Petr Pudlak <pudlak@google.com>
---
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