Revision 60de49c3 htools/Ganeti/THH.hs

b/htools/Ganeti/THH.hs
39 39 
                  , genLuxiOp
40 40 
                  ) where
41 41 

  		





  42
  
  
    
import Control.Monad (liftM)


  		





  
  42
  
    
import Control.Monad (liftM, liftM2)


  		





  43
  43
  
    
import Data.Char


  		





  44
  44
  
    
import Data.List


  		





  45
  45
  
    
import Language.Haskell.TH


  		





  ......




  77
  77
  
    
reprE :: Either String Name -> Q Exp


  		





  78
  78
  
    
reprE = either stringE varE


  		





  79
  79
  
    

  		





  
  80
  
    
-- | Smarter function application.


  		





  
  81
  
    
--


  		





  
  82
  
    
-- This does simply f x, except that if is 'id', it will skip it, in


  		





  
  83
  
    
-- order to generate more readable code when using -ddump-splices.


  		





  
  84
  
    
appFn :: Exp -> Exp -> Exp


  		





  
  85
  
    
appFn f x | f == VarE 'id = x


  		





  
  86
  
    
          | otherwise = AppE f x


  		





  
  87
  
    

  		





  80
  88
  
    
-- * Template code for simple string-equivalent ADTs


  		





  81
  89
  
    

  		





  82
  90
  
    
-- | Generates a data type declaration.


  		





  ......




  454
  462
  
    
  let cname = mkName sname


  		





  455
  463
  
    
      fnames = map (\(nm, _, _) -> mkName nm) fields


  		





  456
  464
  
    
      pat = conP cname (map varP fnames)


  		





  457
  
  
    
      flist = map (\(nm, _, fn) -> appE fn $ varNameE nm) fields


  		





  
  465
  
    
      flist = map (\(nm, _, fn) -> liftM2 appFn fn $ varNameE nm) fields


  		





  458
  466
  
    
      finval = appE finfn (tupE flist)


  		





  459
  467
  
    
  in


  		





  460
  468
  
    
    clause [pat] (normalB finval) []


  		












Also available in:
  Unified diff