Пользовательское получение (Чтение, Показать) для типа перечисления

Скажем, у меня есть этот тип перечисления:

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 из этих ассоциаций. Возможно ли такое?


haskell deriving template-haskell
person Pubby    schedule 13.06.2015    source источник
comment
Примечание: рекомендуется не злоупотреблять Show и Read таким образом. Имейте отдельные классы красивой печати/анализа, если вам нужен класс; но оставьте Show и Read для генерации (и анализа) действительного кода Haskell, представляющего рассматриваемое значение.   -  person Daniel Wagner    schedule 13.06.2015

Ответы (3)


arrow_upward
7
arrow_downward

Документ Обратимые описания синтаксиса: унификация синтаксического анализа и красивой печати описывает одно особенно идиоматическое решение. Ваш пример выглядит так, используя пакет 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

Это разработано, чтобы быть расширяемым для типов, более захватывающих, чем простые перечисления.

person Daniel Wagner    schedule 13.06.2015
comment
invertible-syntax сработало для меня, спасибо! Я также пробовал некоторые подобные пакеты - partial-isomorphisms недокументирован, roundtrip ошибки с более новым haskell/base, aeson-roundtrip зависит от этого, JsonGrammar фокусируется на объектах json, Boomerang кажется более сложным... здорово иметь тот, который действительно работает! - person Kiara Grouwstra; 22.05.2018

arrow_upward
1
arrow_downward

Ага! Я нашел уже существующий код, написанный Саймоном Николлсом. . Этот шаблон 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")
  ])

(Квазикавычки не работали, так что мне придется это выяснить)

person Pubby    schedule 13.06.2015
comment
Пожалуйста, не используйте TH для задач, которые легче решить без него. - person augustss; 13.06.2015

arrow_upward
1
arrow_downward

Я пришел к этому:

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 = []
person Community    schedule 22.09.2017