Don't keep input for error messages
authorKlaus Aehlig <aehlig@google.com>
Wed, 18 Nov 2015 13:59:36 +0000 (14:59 +0100)
committerKlaus Aehlig <aehlig@google.com>
Thu, 19 Nov 2015 12:57:34 +0000 (13:57 +0100)
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 <aehlig@google.com>
Reviewed-by: Oleg Ponomarev <oponomarev@google.com>

src/Ganeti/JSON.hs
src/Ganeti/Objects/Instance.hs
src/Ganeti/OpCodes.hs
src/Ganeti/THH.hs

index 24938e3..823dc31 100644 (file)
@@ -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
index fd8c3d9..e312983 100644 (file)
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell, FunctionalDependencies #-}
+{-# OPTIONS_GHC -O0 #-}
 
 {-| Implementation of the Ganeti Instance config object.
 
index 37b645e..c6ffa5d 100644 (file)
@@ -1,5 +1,5 @@
 {-# LANGUAGE ExistentialQuantification, TemplateHaskell, StandaloneDeriving #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-orphans -O0 #-}
 
 {-| Implementation of the opcodes.
 
index 91f4c53..33c057b 100644 (file)
@@ -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