https://www.reddit.com/r/haskell/comments/bo2xdh/how_to_build_record_fields_out_of_sum_type/

FieldHandler.hs

{-# LANGUAGE
    DataKinds,
    PolyKinds,
    MultiParamTypeClasses,
    TypeOperators,
    DeriveGeneric,
    KindSignatures,
    FlexibleContexts,
    FlexibleInstances,
    TypeFamilies,
    ScopedTypeVariables,
    AllowAmbiguousTypes,
    TypeApplications,
    UndecidableInstances #-}

import Data.Kind (Type)
import GHC.Generics
import GHC.TypeLits (Symbol)

-- * Heterogeneous lists indexed by field names

infixr 1 :+

data a :+ b = a :+ b
  deriving Show

newtype Field (s :: Symbol) a = Field a
  deriving Show

-- Generic conversion.
--
-- The record
--
--    { foo :: Int, bar :: String}
--
-- is converted to
--
--    Field "foo" Int :+ Field "bar" String :+ ()
--
toHList :: (Generic a, GToHList (Rep a)) => a -> ToHList (Rep a) ()
toHList a = gtoHList (from a) ()

-- Apply a function to a field
--
-- There is some wrapping going on, so that the same field cannot be handled twice.
handle :: forall s u v a b. Settable s u v a (Done b) => (a -> b) -> u -> v
handle f = set @s @u @v @a @(Done b) (Done . f)

-- Convert to a homogeneous list once we're done
--
-- An application of this typechecks only once all fields have be handled and the results have the same type.
done :: Homogeneous u (Done a) => u -> [a]
done = fmap unDone . collect

-- Example

data Example = Example
  { foo :: Int
  , bar :: String
  } deriving Generic

process :: Example -> [Int]
process = done
  . handle @"foo" (\i -> i)
  . handle @"bar" (\s -> length s)
  . toHList

example :: Example
example = Example {foo = 33, bar = "baz"}

-- 33    -> 33
-- "baz" -> length "baz"
-- {foo = 33, bar = "baz"} -> [33,3]

main :: IO ()
main = print (process example)

-- * Internals

-- ** Implementation of generic conversion

-- The type of ToHList is morally (Rep -> DList (Symbol, Type)) where Rep is
-- the type of generic representation, and DList the type of difference lists
-- (this spares us from having to define type-level (++))
type family ToHList (f :: k -> *) (r :: Type) :: Type where
  ToHList (M1 S s (K1 i a)) r = Field (FieldName s) a :+ r
  ToHList (M1 i c f) r = ToHList f r
  ToHList (f :*: g) r = ToHList f (ToHList g r)

type family FieldName (s :: Meta) where
  FieldName ('MetaSel ('Just s) _su _ss _ds) = s

class GToHList f where
  gtoHList :: forall r p. f p -> r -> ToHList f r

instance GToHList (M1 S s (K1 i a)) where
  gtoHList (M1 (K1 a)) r = Field a :+ r

instance GToHList f => GToHList (M1 C c f) where
  gtoHList (M1 a) = gtoHList a

instance GToHList f => GToHList (M1 D c f) where
  gtoHList (M1 a) = gtoHList a

instance (GToHList f, GToHList g) => GToHList (f :*: g) where
  gtoHList (a :*: b) = gtoHList a . gtoHList b

-- * Apply a function to an element of a hetero. list

class Settable (s :: Symbol) u v a b where
  set :: (a -> b) -> u -> v

instance {-# OVERLAPPING #-}
  (v ~ (Field s b :+ u), a ~ a') => Settable s (Field s a' :+ u) v a b where
  set f (Field a :+ b) = Field (f a) :+ b

instance (v' ~ (Field s' a' :+ v), Settable s u v a b) =>
  Settable s (Field s' a' :+ u) v' a b where
  set f (a :+ b) = a :+ set @s @u @v @a @b f b

-- * Finalizing the result

-- Heterogeneous -> Homogeneous
class Homogeneous u a where
  collect :: u -> [a]

instance (a ~ a', Homogeneous u a) => Homogeneous (Field s a' :+ u) a where
  collect (Field a :+ b) = a : collect b

instance Homogeneous () a where
  collect _ = []

--

newtype Done a = Done { unDone :: a }
-- Marker to avoid processing a field twice.
-- No instances: the point is that we can't do anything with it.