枚举类型的自定义派生(读取、显示)
Custom deriving(Read,Show) for enum type
假设我有这个枚举类型:
data TVShow = BobsBurgers | MrRobot | BatmanTAS
我想为 Read
和 Show
定义具有以下行为的实例:
show BobsBurgers = "Bob's Burgers"
show MrRobot = "Mr. Robot"
show BatmanTAS = "Batman: The Animated Series"
read "Bob's Burgers" = BobsBurgers
read "Mr. Robot" = MrRobot
read "Batman: The Animated Series" = BatmanTAS
这些定义中有很多重复,所以我想将每个类型构造函数与一个字符串相关联,然后从这些关联中自动生成 Show
和 Read
。这种事情可能吗?
啊哈! I found some pre-existing code written by 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 不起作用,所以我必须调查一下)
论文 Invertible Syntax Descriptions: Unifying Parsing and Pretty Printing describes one particularly idiomatic solution. Your example looks like this, using the invertible-syntax 基于该论文的包:
import Prelude hiding (Applicative(..), print)
import Data.Maybe (fromJust)
import Text.Syntax
import Text.Syntax.Parser.Naive
import Text.Syntax.Printer.Naive
data TVShow = BobsBurgers | MrRobot | BatmanTAS deriving (Eq, Ord)
tvShow :: Syntax f => f TVShow
tvShow = pure BobsBurgers <* text "Bob's Burgers"
<|> pure MrRobot <* text "Mr. Robot"
<|> pure BatmanTAS <* text "Batman: The Animated Series"
runParser (Parser p) = p
instance Read TVShow where readsPrec _ = runParser tvShow
instance Show TVShow where show = fromJust . print tvShow
这也被设计为可扩展为比简单枚举更令人兴奋的类型。
我来到这里:
data FeedbackType
= Abuse
| AuthFailure
| Fraud
| NotSpam
| Virus
| Other
deriving (Eq)
instance Show FeedbackType where
show Abuse = "abuse"
show AuthFailure = "auth-failure"
show Fraud = "fraud"
show NotSpam = "not-spam"
show Virus = "virus"
show Other = "other"
instance Read FeedbackType where
readsPrec _ s
| s == show Abuse = [(Abuse, "")]
| s == show AuthFailure = [(AuthFailure, "")]
| s == show Fraud = [(Fraud, "")]
| s == show NotSpam = [(NotSpam, "")]
| s == show Virus = [(Virus, "")]
| s == show Other = [(Other, "")]
| otherwise = []
假设我有这个枚举类型:
data TVShow = BobsBurgers | MrRobot | BatmanTAS
我想为 Read
和 Show
定义具有以下行为的实例:
show BobsBurgers = "Bob's Burgers"
show MrRobot = "Mr. Robot"
show BatmanTAS = "Batman: The Animated Series"
read "Bob's Burgers" = BobsBurgers
read "Mr. Robot" = MrRobot
read "Batman: The Animated Series" = BatmanTAS
这些定义中有很多重复,所以我想将每个类型构造函数与一个字符串相关联,然后从这些关联中自动生成 Show
和 Read
。这种事情可能吗?
啊哈! I found some pre-existing code written by 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 不起作用,所以我必须调查一下)
论文 Invertible Syntax Descriptions: Unifying Parsing and Pretty Printing describes one particularly idiomatic solution. Your example looks like this, using the invertible-syntax 基于该论文的包:
import Prelude hiding (Applicative(..), print)
import Data.Maybe (fromJust)
import Text.Syntax
import Text.Syntax.Parser.Naive
import Text.Syntax.Printer.Naive
data TVShow = BobsBurgers | MrRobot | BatmanTAS deriving (Eq, Ord)
tvShow :: Syntax f => f TVShow
tvShow = pure BobsBurgers <* text "Bob's Burgers"
<|> pure MrRobot <* text "Mr. Robot"
<|> pure BatmanTAS <* text "Batman: The Animated Series"
runParser (Parser p) = p
instance Read TVShow where readsPrec _ = runParser tvShow
instance Show TVShow where show = fromJust . print tvShow
这也被设计为可扩展为比简单枚举更令人兴奋的类型。
我来到这里:
data FeedbackType
= Abuse
| AuthFailure
| Fraud
| NotSpam
| Virus
| Other
deriving (Eq)
instance Show FeedbackType where
show Abuse = "abuse"
show AuthFailure = "auth-failure"
show Fraud = "fraud"
show NotSpam = "not-spam"
show Virus = "virus"
show Other = "other"
instance Read FeedbackType where
readsPrec _ s
| s == show Abuse = [(Abuse, "")]
| s == show AuthFailure = [(AuthFailure, "")]
| s == show Fraud = [(Fraud, "")]
| s == show NotSpam = [(NotSpam, "")]
| s == show Virus = [(Virus, "")]
| s == show Other = [(Other, "")]
| otherwise = []