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