Custom deriving(Read,Show) for enum type

Question

Let's say I have this enumeration type:

data TVShow = BobsBurgers | MrRobot | BatmanTAS

and I want to define instances for Read and Show with the following behavior:

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

There is lots of repetition in these definitions, and so I'd like to associate each type constructor with a string and then generate Show and Read automatically from those associations. Is such a thing possible?

Answer 1

The paper Invertible Syntax Descriptions: Unifying Parsing and Pretty Printing describes one particularly idiomatic solution. Your example looks like this, using the invertible-syntax package based on that paper:

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

This is designed to be extensible to types more exciting than simple enumerations, as well.

Answer 2

Aha! I found some pre-existing code written by Simon Nicholls. This template haskell can be used to achieve what I wanted:

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'

Usage:

$(mkEnum "TVShow"
  [ ("BobsBurgers", "Bob's Burgers")
  , ("MrRobot", "Mr. Robot")
  , ("BatmanTAS", "Batman: The Animated Series")
  ])

(The QuasiQuotes weren't working, so I'll have to investigate that)