Commit a35a4f52 authored by Klaus Aehlig's avatar Klaus Aehlig

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: default avatarKlaus Aehlig <aehlig@google.com>
Reviewed-by: default avatarPetr Pudlak <pudlak@google.com>
parent 17aa37ff
...@@ -128,6 +128,7 @@ HS_DIRS = \ ...@@ -128,6 +128,7 @@ HS_DIRS = \
src/Ganeti/HTools/Program \ src/Ganeti/HTools/Program \
src/Ganeti/Hypervisor \ src/Ganeti/Hypervisor \
src/Ganeti/Hypervisor/Xen \ src/Ganeti/Hypervisor/Xen \
src/Ganeti/JQueue \
src/Ganeti/Locking \ src/Ganeti/Locking \
src/Ganeti/Logging \ src/Ganeti/Logging \
src/Ganeti/Monitoring \ src/Ganeti/Monitoring \
...@@ -776,6 +777,7 @@ HS_LIB_SRCS = \ ...@@ -776,6 +777,7 @@ HS_LIB_SRCS = \
src/Ganeti/Hs2Py/GenOpCodes.hs \ src/Ganeti/Hs2Py/GenOpCodes.hs \
src/Ganeti/Hs2Py/OpDoc.hs \ src/Ganeti/Hs2Py/OpDoc.hs \
src/Ganeti/JQueue.hs \ src/Ganeti/JQueue.hs \
src/Ganeti/JQueue/Objects.hs \
src/Ganeti/JQScheduler.hs \ src/Ganeti/JQScheduler.hs \
src/Ganeti/JSON.hs \ src/Ganeti/JSON.hs \
src/Ganeti/Jobs.hs \ src/Ganeti/Jobs.hs \
......
{-# LANGUAGE TemplateHaskell #-}
{-| Implementation of the job queue. {-| Implementation of the job queue.
-} -}
...@@ -26,16 +24,12 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ...@@ -26,16 +24,12 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-} -}
module Ganeti.JQueue module Ganeti.JQueue
( QueuedOpCode(..) ( queuedOpCodeFromMetaOpCode
, QueuedJob(..)
, InputOpCode(..)
, queuedOpCodeFromMetaOpCode
, queuedJobFromOpCodes , queuedJobFromOpCodes
, changeOpCodePriority , changeOpCodePriority
, changeJobPriority , changeJobPriority
, cancelQueuedJob , cancelQueuedJob
, failQueuedJob , failQueuedJob
, Timestamp
, fromClockTime , fromClockTime
, noTimestamp , noTimestamp
, currentTimestamp , currentTimestamp
...@@ -70,6 +64,11 @@ module Ganeti.JQueue ...@@ -70,6 +64,11 @@ module Ganeti.JQueue
, cancelJob , cancelJob
, queueDirPermissions , queueDirPermissions
, archiveJobs , archiveJobs
-- re-export
, Timestamp
, InputOpCode(..)
, QueuedOpCode(..)
, QueuedJob(..)
) where ) where
import Control.Applicative (liftA2, (<|>)) import Control.Applicative (liftA2, (<|>))
...@@ -100,6 +99,7 @@ import Ganeti.BasicTypes ...@@ -100,6 +99,7 @@ import Ganeti.BasicTypes
import qualified Ganeti.Config as Config import qualified Ganeti.Config as Config
import qualified Ganeti.Constants as C import qualified Ganeti.Constants as C
import Ganeti.Errors (ErrorResult, ResultG) import Ganeti.Errors (ErrorResult, ResultG)
import Ganeti.JQueue.Objects
import Ganeti.JSON import Ganeti.JSON
import Ganeti.Logging import Ganeti.Logging
import Ganeti.Luxi import Ganeti.Luxi
...@@ -109,8 +109,6 @@ import Ganeti.Path ...@@ -109,8 +109,6 @@ import Ganeti.Path
import Ganeti.Query.Exec as Exec import Ganeti.Query.Exec as Exec
import Ganeti.Rpc (executeRpcCall, ERpcError, logRpcErrors, import Ganeti.Rpc (executeRpcCall, ERpcError, logRpcErrors,
RpcCallJobqueueUpdate(..), RpcCallJobqueueRename(..)) RpcCallJobqueueUpdate(..), RpcCallJobqueueRename(..))
import Ganeti.THH
import Ganeti.THH.Field
import Ganeti.Types import Ganeti.Types
import Ganeti.Utils import Ganeti.Utils
import Ganeti.Utils.Atomic import Ganeti.Utils.Atomic
...@@ -119,11 +117,6 @@ import Ganeti.VCluster (makeVirtualPath) ...@@ -119,11 +117,6 @@ import Ganeti.VCluster (makeVirtualPath)
-- * Data types -- * 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. -- | Missing timestamp type.
noTimestamp :: Timestamp noTimestamp :: Timestamp
noTimestamp = (-1, -1) noTimestamp = (-1, -1)
...@@ -142,25 +135,12 @@ currentTimestamp = fromClockTime `liftM` getClockTime ...@@ -142,25 +135,12 @@ currentTimestamp = fromClockTime `liftM` getClockTime
advanceTimestamp :: Int -> Timestamp -> Timestamp advanceTimestamp :: Int -> Timestamp -> Timestamp
advanceTimestamp = first . (+) 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. -- | From an InputOpCode obtain the MetaOpCode, if any.
toMetaOpCode :: InputOpCode -> [MetaOpCode] toMetaOpCode :: InputOpCode -> [MetaOpCode]
toMetaOpCode (ValidOpCode mopc) = [mopc] toMetaOpCode (ValidOpCode mopc) = [mopc]
toMetaOpCode _ = [] 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. -- | Invalid opcode summary.
invalidOp :: String invalidOp :: String
invalidOp = "INVALID_OP" invalidOp = "INVALID_OP"
...@@ -176,35 +156,6 @@ extractOpSummary (InvalidOpCode (JSObject o)) = ...@@ -176,35 +156,6 @@ extractOpSummary (InvalidOpCode (JSObject o)) =
Nothing -> invalidOp Nothing -> invalidOp
extractOpSummary _ = 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 -- | Convenience function to obtain a QueuedOpCode from a MetaOpCode
queuedOpCodeFromMetaOpCode :: MetaOpCode -> QueuedOpCode queuedOpCodeFromMetaOpCode :: MetaOpCode -> QueuedOpCode
queuedOpCodeFromMetaOpCode op = queuedOpCodeFromMetaOpCode op =
......
{-# 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"
])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment