HasField.hs

module Records.EDSL.Deriving.HasField where

import Data.Proxy
import GHC.Records qualified as GHC
import Language.Haskell.TH qualified as TH
import Records.EDSL.Deriving.Type
import Records.EDSL.Description
import Relude

deriveHasFields :: Deriver
deriveHasFields = deriver #ghc_HasField \RecordDesc {typeName, fields} ->
  concat <$> forM fields \FieldDesc {name, nameText, type_} ->
    if toText (TH.nameBase name) == nameText
      then pure []
      else
        [d|
          instance GHC.HasField $(TH.litT (TH.strTyLit (toString nameText))) $(TH.conT typeName) $(pure type_.hask.type_) where
            getField = getFieldP (Proxy :: Proxy $(TH.litT (TH.strTyLit (TH.nameBase name))))
              where
                getFieldP :: forall x r a. (GHC.HasField x r a) => Proxy x -> r -> a
                getFieldP _ = GHC.getField @x
          |]