啊哈!我发现了一些由 Simon Nicholls 编写的预先存在的代码。这个模板haskell可以用来实现我想要的:
genData :: Name -> [Name] -> DecQ
genData name keys = dataD (cxt []) name [] cons [''Eq, ''Enum, ''Bounded]
where cons = map (\n -> normalC n []) keys
genShow :: Name -> [(Name, String)] -> DecQ
genShow name pairs =
instanceD (cxt [])
(appT (conT ''Show) (conT name))
[funD (mkName "show") $ map genClause pairs]
where
genClause (k, v) = clause [(conP k [])] (normalB [|v|]) []
mkEnum :: String -> [(String, String)] -> Q [Dec]
mkEnum name' pairs' =
do
ddec <- genData name (map fst pairs)
sdec <- genShow name pairs
rdec <- [d|instance Read $(conT name) where
readsPrec _ value =
case Map.lookup value m of
Just val -> [(val, [])]
Nothing -> []
where
m = Map.fromList $ map (show &&& id) [minBound..maxBound]|]
return $ ddec : sdec : rdec
where name = mkName name'
pairs = map (\(k, v) -> (mkName k, v)) pairs'
用法:
$(mkEnum "TVShow"
[ ("BobsBurgers", "Bob's Burgers")
, ("MrRobot", "Mr. Robot")
, ("BatmanTAS", "Batman: The Animated Series")
])
(QuasiQuotes 不起作用,所以我必须调查一下)