Commit 60de49c3 authored by Iustin Pop's avatar Iustin Pop
Browse files

Skip application of 'id' in TH code



This is just beautification when dumping splices to stdout, as ghc
will optimise the 'id' away anyway.

Original generate code:

  opToArgs QueryTags kind name = J.showJSON (id kind, id name)

Afterwards:

  opToArgs QueryTags kind name = J.showJSON (kind, name)
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 9888b9e6
......@@ -39,7 +39,7 @@ module Ganeti.THH ( declareSADT
, genLuxiOp
) where
import Control.Monad (liftM)
import Control.Monad (liftM, liftM2)
import Data.Char
import Data.List
import Language.Haskell.TH
......@@ -77,6 +77,14 @@ fromStrName = mkName . (++ "FromString") . ensureLower
reprE :: Either String Name -> Q Exp
reprE = either stringE varE
-- | Smarter function application.
--
-- This does simply f x, except that if is 'id', it will skip it, in
-- order to generate more readable code when using -ddump-splices.
appFn :: Exp -> Exp -> Exp
appFn f x | f == VarE 'id = x
| otherwise = AppE f x
-- * Template code for simple string-equivalent ADTs
-- | Generates a data type declaration.
......@@ -454,7 +462,7 @@ saveLuxiConstructor (sname, fields, finfn) =
let cname = mkName sname
fnames = map (\(nm, _, _) -> mkName nm) fields
pat = conP cname (map varP fnames)
flist = map (\(nm, _, fn) -> appE fn $ varNameE nm) fields
flist = map (\(nm, _, fn) -> liftM2 appFn fn $ varNameE nm) fields
finval = appE finfn (tupE flist)
in
clause [pat] (normalB finval) []
......
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