LGTM. Just some nitpicking:
On Thu, Dec 12, 2013 at 5:20 PM, Klaus Aehlig <[email protected]> wrote: > The instantiation of RPC requires a bidirectional functional dependency > between call type and return type. Hence we cannot use Unit everywhere. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > src/Ganeti/JQueue.hs | 8 +++++--- > src/Ganeti/Rpc.hs | 6 ++++-- > 2 files changed, 9 insertions(+), 5 deletions(-) > > diff --git a/src/Ganeti/JQueue.hs b/src/Ganeti/JQueue.hs > index 1d2cfb5..c320769 100644 > --- a/src/Ganeti/JQueue.hs > +++ b/src/Ganeti/JQueue.hs > @@ -58,6 +58,7 @@ module Ganeti.JQueue > , startJobs > ) where > > +import Control.Arrow (second) > import Control.Concurrent.MVar > import Control.Exception > import Control.Monad > @@ -65,7 +66,7 @@ import Data.List > import Data.Maybe > import Data.Ord (comparing) > -- workaround what seems to be a bug in ghc 7.4's TH shadowing code > -import Prelude hiding (log, id) > +import Prelude hiding (id, log) > import System.Directory > import System.FilePath > import System.IO.Error (isDoesNotExistError) > @@ -381,8 +382,9 @@ replicateJob :: FilePath -> [Node] -> QueuedJob -> IO > [(Node, ERpcError ())] > replicateJob rootdir mastercandidates job = do > let filename = liveJobFile rootdir . qjId $ job > content = Text.JSON.encode . Text.JSON.showJSON $ job > - result <- executeRpcCall mastercandidates > - $ RpcCallJobqueueUpdate filename content > + callresult <- executeRpcCall mastercandidates > + $ RpcCallJobqueueUpdate filename content > + let result = map (second (either Left (const $ Right ()))) callresult > A shorter version would be `map (second (() <$)) callresult`, which IMHO makes it easier to understand that we're just discarding results. There is function `void` in Control.Monad that is equal to (() <$), but unfortunately available only in GHC7. > logRpcErrors result > return result > > diff --git a/src/Ganeti/Rpc.hs b/src/Ganeti/Rpc.hs > index 3a49ccb..4ddd409 100644 > --- a/src/Ganeti/Rpc.hs > +++ b/src/Ganeti/Rpc.hs > @@ -567,6 +567,8 @@ $(buildObject "RpcCallJobqueueUpdate" > "rpcCallJobqueueUpdate" > , simpleField "content" [t| String |] > ]) > > +$(buildObject "RpcResultJobQueueUpdate" "rpcResultJobQueueUpdate" []) > + > instance RpcCall RpcCallJobqueueUpdate where > rpcCallName _ = "jobqueue_update" > rpcCallTimeout _ = rpcTimeoutToRaw Fast > @@ -579,10 +581,10 @@ instance RpcCall RpcCallJobqueueUpdate where > ) > ) > > -instance Rpc RpcCallJobqueueUpdate () where > +instance Rpc RpcCallJobqueueUpdate RpcResultJobQueueUpdate where > rpcResultFill _ res = > case res of > - J.JSNull -> Right () > + J.JSNull -> Right RpcResultJobQueueUpdate > _ -> Left $ JsonDecodeError > ("Expected JSNull, got " ++ show (pp_value res)) > > -- > 1.8.5.1 > >
