wrap all the fields of a record in a functor, and still allow indexing by field name

WrappedFields.hs

{-# LANGUAGE DataKinds, 
             TypeFamilies, 
             FlexibleInstances,
             UndecidableInstances, 
             ScopedTypeVariables, 
             TypeApplications, 
             TypeOperators, 
             MultiParamTypeClasses,
             FunctionalDependencies,
             AllowAmbiguousTypes,
             DeriveGeneric,
             StandaloneDeriving
             #-}
module Main where

import           Data.Kind (Type)
import           Data.Type.Equality (type (==))
import           GHC.TypeLits
import qualified GHC.Generics as GHC
import           Generics.SOP -- from package "generics-sop"
import qualified Generics.SOP.Type.Metadata as M

newtype Wrapped f (ns :: [Symbol]) (xs :: [Type]) = Wrapped { unwrap :: NP f xs }

deriving instance All (Generics.SOP.Compose Show f) xs => Show (Wrapped f ns xs)

type family FieldNamesOf (a :: M.DatatypeInfo) :: [Symbol] where
    FieldNamesOf ('M.ADT moduleName datatypeName '[ 'M.Record constructorName fields ]) = ExtractFieldNames fields

type family ExtractFieldNames (a :: [M.FieldInfo]) :: [Symbol] where
    ExtractFieldNames '[] = '[]
    ExtractFieldNames (('M.FieldInfo n) ': xs) = n ': ExtractFieldNames xs

fromRecord :: forall r ns xs.  
              (IsProductType r xs, 
               HasDatatypeInfo r,
               FieldNamesOf (DatatypeInfoOf r) ~ ns)
           => r
           -> Wrapped I ns xs 
fromRecord r = 
    let (SOP (Z np)) = from r
     in Wrapped np

toRecord :: forall r ns xs.  
           (IsProductType r xs, 
            HasDatatypeInfo r,
            FieldNamesOf (DatatypeInfoOf r) ~ ns)
        => Wrapped I ns xs 
        -> r
toRecord (Wrapped np) = to (SOP (Z np))

class HasField (ns :: [Symbol]) (n :: Symbol) (xs :: [Type]) (x :: Type) | ns n xs -> x where 
    getHasField :: NP f xs -> f x 

instance ((e == n) ~ flag, HasField' flag (e : ns) n xs x) => HasField (e : ns) n xs x where
    getHasField = getHasField' @flag @(e : ns) @n

class HasField' (flag :: Bool) (ns :: [Symbol]) (n :: Symbol) (xs :: [Type]) (x :: Type) | ns n xs -> x where 
    getHasField' :: NP f xs -> f x 

instance HasField' True (n : ns) n (x : xs) x where
    getHasField' (v :* _) = v

instance HasField ns n xs x => HasField' False (nz : ns) n (xz : xs) x where
    getHasField' (_ :* rest) = getHasField @ns @n rest

getWrappedField :: forall n f ns xs x. HasField ns n xs x => Wrapped f ns xs -> f x
getWrappedField (Wrapped np) = getHasField @ns @n np  

data Person = Person { name :: String, age :: Int } deriving (Show, GHC.Generic)
instance Generic Person
instance HasDatatypeInfo Person

-- ghci> getWrappedField @"name" (fromRecord (Person "Jimmy" 25))
-- I "Jimmy"