diff

36,37c36,37
<   ( HasField name (val -> val) functions
<   , HasField name val values
---
>   ( HasField' name (val -> val) functions
>   , HasField' name val values

error_changed

Ex_RowToList.hs:104:11: error:
    * The type [Char] does not contain a field named 'b'.
    * In the second argument of `($)', namely
        `pairwiseApply functions values'
      In a stmt of a 'do' block: print $ pairwiseApply functions values
      In the expression: do print $ pairwiseApply functions values
    |
104 |   print $ pairwiseApply functions values
    |           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

error_origin

Ex_RowToList_origin.hs:36:5: error:
    * Expecting two more arguments to `HasField name (val
                                                      -> val) functions'
      Expected a constraint,
        but `HasField name (val -> val) functions' has kind `*
                                                             -> * -> Constraint'
    * In the instance declaration for
        `PairwiseApply functions (('(name, (val -> val)))
                                  : fnTail) values ('(name, val) : valTail)'
   |
36 |   ( HasField name (val -> val) functions
   |     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Ex_RowToList_origin.hs:37:5: error:
    * Expecting two more arguments to `HasField name val values'
      Expected a constraint,
        but `HasField name val values' has kind `* -> * -> Constraint'
    * In the instance declaration for
        `PairwiseApply functions (('(name, (val -> val)))
                                  : fnTail) values ('(name, val) : valTail)'
   |
37 |   , HasField name val values
   |     ^^^^^^^^^^^^^^^^^^^^^^^^
Failed, 26 modules loaded.

Ex_RowToList_changed.hs

-- design part
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
-- usage part
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}

import GHC.Generics
import Data.Proxy
import GHC.TypeLits
import Data.Generics.Product

class PairwiseApply
    functions (functionsList :: [(Symbol, *)])
    values (valuesList :: [(Symbol, *)])
  where
    pairwiseApplyImpl
      :: Proxy functionsList
      -> Proxy valuesList
      -> functions
      -> values
      -> values

instance PairwiseApply functions '[] values '[] where
  pairwiseApplyImpl _ _ _ x = x

instance
  ( HasField' name (val -> val) functions
  , HasField' name val values
  , PairwiseApply functions fnTail values valTail
  ) => PairwiseApply
         functions (('(name, (val -> val))) ': fnTail)
         values ('(name, val) ': valTail) where
  pairwiseApplyImpl _ _ fns vals = do
      setField @name (fn val) vals'
    where
      fn = getField @name fns
      val = getField @name vals
      vals' = pairwiseApplyImpl (Proxy @fnTail) (Proxy @valTail) fns vals

pairwiseApply :: forall vals fns valsL fnsL
   . Generic fns
  => Generic vals
  => fnsL ~ GRowToList (Rep fns)
  => valsL ~ GRowToList (Rep vals)
  => PairwiseApply
       fns fnsL
       vals valsL
  => fns
  -> vals
  -> vals
pairwiseApply =
  pairwiseApplyImpl
    (Proxy @fnsL)
    (Proxy @valsL)

type family GRowToList (r :: * -> *) :: [(Symbol, *)] where
  GRowToList (l :*: r)
    = GRowToList l ++ GRowToList r
  GRowToList (S1 ('MetaSel ('Just name) _ _ _) (Rec0 a))
    = '[ '(name, a) ]
  GRowToList (M1 _ m a)
    = GRowToList a
  GRowToList U1 = '[]

type family (a :: [k]) ++ (b :: [k]) :: [k] where
  '[] ++ bs = bs
  (a ': as) ++ bs = a ': (as ++ bs)


--usage part
data Values = Values
  { a :: Int
  , b :: String
  } deriving (Generic, Show)

data Functions = Functions
  { a :: Int -> Int
  , b :: String -> String
  } deriving (Generic)

values :: Values
values = Values
  { a = 1
  , b = "pen"
  }

functions :: Functions
functions = Functions
  { a = (+) 1
  , b = (++) "apple"
  }

main :: IO ()
main = do
  print $ pairwiseApply functions values
  -- output:
  -- Values {a = 2, b = "applepen"}

Ex_RowToList_origin.hs

-- design part
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
-- usage part
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}

import GHC.Generics
import Data.Proxy
import GHC.TypeLits
import Data.Generics.Product

class PairwiseApply
    functions (functionsList :: [(Symbol, *)])
    values (valuesList :: [(Symbol, *)])
  where
    pairwiseApplyImpl
      :: Proxy functionsList
      -> Proxy valuesList
      -> functions
      -> values
      -> values

instance PairwiseApply functions '[] values '[] where
  pairwiseApplyImpl _ _ _ x = x

instance
  ( HasField name (val -> val) functions
  , HasField name val values
  , PairwiseApply functions fnTail values valTail
  ) => PairwiseApply
         functions (('(name, (val -> val))) ': fnTail)
         values ('(name, val) ': valTail) where
  pairwiseApplyImpl _ _ fns vals = do
      setField @name (fn val) vals'
    where
      fn = getField @name fns
      val = getField @name vals
      vals' = pairwiseApplyImpl (Proxy @fnTail) (Proxy @valTail) fns vals

pairwiseApply :: forall vals fns valsL fnsL
   . Generic fns
  => Generic vals
  => fnsL ~ GRowToList (Rep fns)
  => valsL ~ GRowToList (Rep vals)
  => PairwiseApply
       fns fnsL
       vals valsL
  => fns
  -> vals
  -> vals
pairwiseApply =
  pairwiseApplyImpl
    (Proxy @fnsL)
    (Proxy @valsL)

type family GRowToList (r :: * -> *) :: [(Symbol, *)] where
  GRowToList (l :*: r)
    = GRowToList l ++ GRowToList r
  GRowToList (S1 ('MetaSel ('Just name) _ _ _) (Rec0 a))
    = '[ '(name, a) ]
  GRowToList (M1 _ m a)
    = GRowToList a
  GRowToList U1 = '[]

type family (a :: [k]) ++ (b :: [k]) :: [k] where
  '[] ++ bs = bs
  (a ': as) ++ bs = a ': (as ++ bs)


--usage part
data Values = Values
  { a :: Int
  , b :: String
  } deriving (Generic, Show)

data Functions = Functions
  { a :: Int -> Int
  , b :: String -> String
  } deriving (Generic)

values :: Values
values = Values
  { a = 1
  , b = "pen"
  }

functions :: Functions
functions = Functions
  { a = (+) 1
  , b = (++) "apple"
  }

main :: IO ()
main = do
  print $ pairwiseApply functions values
  -- output:
  -- Values {a = 2, b = "applepen"}