Generic conversion of simple ADT to array

Question

Given a sum type:

type PlayerId = String
data Location = Deck | Hand PlayerId

How can I write either of these two functions (I don't care which generic approach to take ... bonus points for helping me figure out which is more appropriate):

myF :: Generic a => a -> [String]
myF :: Data a => a -> [String]

-- roughly equivalent to
myF :: Location -> [String]
myF x = case x of
          Deck     -> ["deck"]
          Hand pid -> ["hand", show pid]

(For any "invalid" type, e.g. the argument is not Showable, either return [] or error.)

Context: I have a number of similar enum-like types that I want to generically define Data.Aeson.ToJSON instances for, though given myF above I know how to do the rest. Though mostly I'm just doing this to learn more about generic programming.

Attempts:

Using Generic

λ> unM1 $ from Deck
(L1 (M1 {unM1 = U1}))

λ> :t (undefined :: Rep Location p)
(undefined :: Rep Location p)
  :: D1
       ('MetaData "Location" "Test" "main" 'False)
       (
         C1 ('MetaCons "Deck" 'PrefixI 'False) U1
         :+:
         C1
           ('MetaCons "Hand" 'PrefixI 'False)
           (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 String)))

Since :+: is defined as L1 | R1, I could probably "merge" the above two results. I'm not sure of a neat way I'd do this though .. maybe pattern match on the former and use it to "descend" in to the latter - but I'm not sure how to cross over between the type definition and real code.

Using Data

AFAICT Data is an alternate approach to generics. You would use either Generic or Data, right?

I think I need to use one of the gmap* functions, but I can't figure out how to relate the types to my problem. Have tried some exploratory "plug random arguments in to various methods" but didn't get anywhere interesting.

UPDATE! I tried to simplify my example, but I may have done so too much. In my actual code, PlayerId is a newtype around string. The following "works" in that case (modulo lower casing the constructor name):

mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
(r `mkQ` q) a = case cast a of
                  Just b -> q b
                  Nothing -> r

myF :: Data a => a -> [String]
myF input =
  [showConstr . toConstr $ input]
  ++ gmapQ (\x -> ("" `mkQ` f) x) input

f :: PlayerId -> String
f (PlayerId x) = x

The insight here was that constructors and arguments need to be treated differently. A remaining problem is that the above code needs to know about PlayerId. The following doesn't work:

f :: Show a => a -> String
f = show

... since that doesn't match the type signature of gmapQ. I think I understand why this is the case: the way gmapQ works is by using cast and this definition of f isn't concrete enough to give it an actual type to cast to. I'm not sure if there is a way around this, or if it is a limitation of using Data. (This is still probably workable though, if not ideal: I can imagine a case where I have myF parameterized by some fs that are specific to the particular arguments in the type.)

It also doesn't feel right because I copied the mkQ function from the original SYB paper ... I would have thought I should be able to do this using functions provided by Data.Data.

Answer 1

Here is a solution using generics-sop.

{-# LANGUAGE DeriveAnyClass, DeriveGeneric, FlexibleContexts, ScopedTypeVariables, TypeApplications #-}

import Data.Char
import Generics.SOP
import qualified GHC.Generics as GHC

type PlayerId = String
data Location = Deck | Hand PlayerId
  deriving (GHC.Generic, Generic, HasDatatypeInfo)

The library uses its own generic representation which can either be derived automatically from the GHC Generic class or via Template Haskell. We use the former approach, which means we have to derive GHC.Generic via the DeriveGeneric extension and then SOP's Generic and HasDatatypeInfo classes via the DeriveAnyClass extension.

We now proceed in two steps. The first is just to get the name of the constructor of a value as a lowercase string (because that's what you used in the example). A variant of this function should really be in the library, but unfortunately, it isn't, so we have to define it ourselves:

lcConstructor :: forall a . (Generic a, HasDatatypeInfo a) => a -> String
lcConstructor x =
  hcollapse
    (hzipWith
      (\ c _ -> K (map toLower (constructorName c)))
      (constructorInfo (datatypeInfo (Proxy @a)))
      (unSOP (from x))
    )

In essence, constructorInfo (datatypeInfo (Proxy @a)) constructs a table of all the constructor information for the type a. The call to hzipWith then selects the right components from the table (the one corresponding to the value x in question). Furthermore, we extract the name from the constructor info and turn it into lowercase characters.

We can test this part:

GHCi> lcConstructor Deck
"deck"
GHCi> lcConstructor (Hand "42")
"hand"

The remaining work is to get string representations of all the constructor arguments and append them to the constructor name:

myF :: (Generic a, HasDatatypeInfo a, All2 Show (Code a)) => a -> [String]
myF a =
  (lcConstructor a :) . hcollapse . hcmap (Proxy @Show) (mapIK show) . from $ a

Here, from turns the value into its representation, then hcmap turns all the arguments of the constructor into strings using show, then hcollapse extracts the results as a list of strings, and (lcConstructor :) prepends the name of the constructor.

GHCi> myF Deck
["deck"]
GHCi> myF (Hand "42")
["hand", "\"42\""]

Answer 2

When using generics you don't need to merge two types of information. All you need is to handle each possible type via instances.

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeOperators #-}
import GHC.Generics

type PlayerId = String
data Location = Deck | Hand PlayerId deriving Generic

instance MyClass Location

class MyClass a where
  myF :: a -> [String]
  default myF :: (Generic a, MyClass1 (Rep a)) => a -> [String]
  myF = defaultMyF

defaultMyF :: (Generic a, MyClass1 (Rep a)) => a -> [String]
defaultMyF a = myF1 $ from a

Rep a has kind * -> * so we cannot implement MyClass directly for U1, V1, M1 etc. Instead we need another class where myF would have type :: a b -> [String].

class MyClass1 a where
  myF1 :: a b -> [String]

instance MyClass1 V1 where
  myF1 _ = []

instance MyClass1 U1 where
  myF1 _ = []

instance MyClass1 (K1 i String) where
  myF1 (K1 a) = [a]

instance (MyClass1 f, Constructor t) => MyClass1 (C1 t f) where
  myF1 c@(M1 a) = (conName c) : myF1 a

instance (MyClass1 f) => MyClass1 (D1 t f) where
  myF1 (M1 a) = myF1 a


instance (MyClass1 f) => MyClass1 (S1 t f) where
  myF1 (M1 a) = myF1 a

instance (MyClass1 a, MyClass1 b) => MyClass1 (a :+: b) where
  myF1 (L1 x) = myF1 x
  myF1 (R1 x) = myF1 x

instance (MyClass1 a, MyClass1 b) => MyClass1 (a :*: b) where
  myF1 (a :*: b) = myF1 a ++ myF1 b

And now you can test it:

main :: IO ()
main = do
  putStrLn $ show $ myF Deck
  putStrLn $ show $ myF $ Hand "1234"