Revision a48daa87
| b/src/Ganeti/THH.hs | ||
|---|---|---|
| 1 |
{-# LANGUAGE ExistentialQuantification, TemplateHaskell #-}
|
|
| 1 |
{-# LANGUAGE ExistentialQuantification, ParallelListComp, TemplateHaskell #-}
|
|
| 2 | 2 |
|
| 3 | 3 |
{-| TemplateHaskell helper for Ganeti Haskell code.
|
| 4 | 4 |
|
| ... | ... | |
| 31 | 31 |
|
| 32 | 32 |
module Ganeti.THH ( declareSADT |
| 33 | 33 |
, declareLADT |
| 34 |
, declareILADT |
|
| 34 | 35 |
, declareIADT |
| 35 | 36 |
, makeJSONInstance |
| 36 | 37 |
, deCamelCase |
| ... | ... | |
| 414 | 415 |
declareLADT :: Name -> String -> [(String, String)] -> Q [Dec] |
| 415 | 416 |
declareLADT = declareADT Left |
| 416 | 417 |
|
| 418 |
declareILADT :: String -> [(String, Int)] -> Q [Dec] |
|
| 419 |
declareILADT sname cons = do |
|
| 420 |
consNames <- sequence [ newName ('_':n) | (n, _) <- cons ]
|
|
| 421 |
consFns <- concat <$> sequence |
|
| 422 |
[ do sig <- sigD n [t| Int |] |
|
| 423 |
let expr = litE (IntegerL (toInteger i)) |
|
| 424 |
fn <- funD n [clause [] (normalB expr) []] |
|
| 425 |
return [sig, fn] |
|
| 426 |
| n <- consNames |
|
| 427 |
| (_, i) <- cons ] |
|
| 428 |
let cons' = [ (n, n') | (n, _) <- cons | n' <- consNames ] |
|
| 429 |
(consFns ++) <$> declareADT Right ''Int sname cons' |
|
| 430 |
|
|
| 417 | 431 |
declareIADT :: String -> [(String, Name)] -> Q [Dec] |
| 418 | 432 |
declareIADT = declareADT Right ''Int |
| 419 | 433 |
|
Also available in: Unified diff