NACK - the reason why optimization has been disabled should be added as a comment in the code as well as the commit message.
On Thu, Nov 19, 2015 at 1:18 PM, 'Oleg Ponomarev' via ganeti-devel < [email protected]> wrote: > LGTM, thanks > > > On 11/19/2015 01:04 PM, 'Klaus Aehlig' via ganeti-devel wrote: > >> When generating error messages, the raw JSValue is rarely >> useful. However, keeping it for error messages---even if >> only in the unused branch of an if statement---prevents this >> value from going out of scope. >> >> Note: with the smaller number of arguments in the readJSONWithDesc >> function, newer versions of ghc try too fancy optimisations and thus >> run out of memory; hence we have to reduce the ghc optimisation level >> for some files. >> >> Signed-off-by: Klaus Aehlig <[email protected]> >> --- >> src/Ganeti/JSON.hs | 8 ++------ >> src/Ganeti/Objects/Instance.hs | 1 + >> src/Ganeti/OpCodes.hs | 2 +- >> src/Ganeti/THH.hs | 6 +++--- >> 4 files changed, 7 insertions(+), 10 deletions(-) >> >> diff --git a/src/Ganeti/JSON.hs b/src/Ganeti/JSON.hs >> index 24938e3..823dc31 100644 >> --- a/src/Ganeti/JSON.hs >> +++ b/src/Ganeti/JSON.hs >> @@ -135,16 +135,12 @@ type JSRecord = [JSField] >> -- is being parsed into what. >> readJSONWithDesc :: (J.JSON a) >> => String -- ^ description of @a@ >> - -> Bool -- ^ include input in >> - -- error messages >> -> J.JSValue -- ^ input value >> -> J.Result a >> -readJSONWithDesc name incInput input = >> +readJSONWithDesc name input = >> case J.readJSON input of >> J.Ok r -> J.Ok r >> - J.Error e -> J.Error $ if incInput then msg ++ " from " ++ show input >> - else msg >> - where msg = "Can't parse value for '" ++ name ++ "': " ++ e >> + J.Error e -> J.Error $ "Can't parse value for '" ++ name ++ "': " ++ >> e >> -- | Converts a JSON Result into a monadic value. >> fromJResult :: Monad m => String -> J.Result a -> m a >> diff --git a/src/Ganeti/Objects/Instance.hs >> b/src/Ganeti/Objects/Instance.hs >> index fd8c3d9..e312983 100644 >> --- a/src/Ganeti/Objects/Instance.hs >> +++ b/src/Ganeti/Objects/Instance.hs >> @@ -1,4 +1,5 @@ >> {-# LANGUAGE TemplateHaskell, FunctionalDependencies #-} >> +{-# OPTIONS_GHC -O0 #-} >> {-| Implementation of the Ganeti Instance config object. >> diff --git a/src/Ganeti/OpCodes.hs b/src/Ganeti/OpCodes.hs >> index 37b645e..c6ffa5d 100644 >> --- a/src/Ganeti/OpCodes.hs >> +++ b/src/Ganeti/OpCodes.hs >> @@ -1,5 +1,5 @@ >> {-# LANGUAGE ExistentialQuantification, TemplateHaskell, >> StandaloneDeriving #-} >> -{-# OPTIONS_GHC -fno-warn-orphans #-} >> +{-# OPTIONS_GHC -fno-warn-orphans -O0 #-} >> {-| Implementation of the opcodes. >> diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs >> index 91f4c53..33c057b 100644 >> --- a/src/Ganeti/THH.hs >> +++ b/src/Ganeti/THH.hs >> @@ -324,7 +324,7 @@ parseFn :: Field -- ^ The field definition >> -> Q Exp -- ^ The resulting function that parses a JSON >> message >> parseFn field o = >> let fnType = [t| JSON.JSValue -> JSON.Result $(fieldType field) |] >> - expr = maybe [| readJSONWithDesc $(stringE $ fieldName field) >> False |] >> + expr = maybe [| readJSONWithDesc $(stringE $ fieldName field) |] >> (`appE` o) (fieldRead field) >> in sigE expr fnType >> @@ -580,7 +580,7 @@ genReadJSON :: String -> Q Dec >> genReadJSON name = do >> let s = mkName "s" >> body <- [| $(varE (fromRawName name)) =<< >> - readJSONWithDesc $(stringE name) True $(varE s) |] >> + readJSONWithDesc $(stringE name) $(varE s) |] >> return $ FunD 'JSON.readJSON [Clause [VarP s] (NormalB body) []] >> -- | Generates a JSON instance for a given type. >> @@ -1299,7 +1299,7 @@ objectReadJSON :: String -> Q Dec >> objectReadJSON name = do >> let s = mkName "s" >> body <- [| $(varE . mkName $ "load" ++ name) =<< >> - readJSONWithDesc $(stringE name) False $(varE s) |] >> + readJSONWithDesc $(stringE name) $(varE s) |] >> return $ FunD 'JSON.readJSON [Clause [VarP s] (NormalB body) []] >> -- * Inheritable parameter tables implementation >> > > Hrvoje Ribicic Ganeti Engineering Google Germany GmbH Dienerstr. 12, 80331, München Geschäftsführer: Matthew Scott Sucherman, Paul Terence Manicle Registergericht und -nummer: Hamburg, HRB 86891 Sitz der Gesellschaft: Hamburg Diese E-Mail ist vertraulich. Wenn Sie nicht der richtige Adressat sind, leiten Sie diese bitte nicht weiter, informieren Sie den Absender und löschen Sie die E-Mail und alle Anhänge. Vielen Dank. This e-mail is confidential. If you are not the right addressee please do not forward it, please inform the sender, and please erase this e-mail including any attachments. Thanks.
