lift `Record xs` to `RecordOf h ys`

PolyPersonParams.hs

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels      #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

module Person where

import           Data.Extensible
import           Data.Text
import           Lens.Micro      ((^.))

newtype Required a = Required a deriving (Show)

instance Wrapper Required where
  type Repr Required x = x
  wrap = Required
  unwrap (Required x) = x

newtype Optional a = Optional (Maybe a) deriving (Show)

type PersonParams = Record PersonParamsFields
type PersonParamsFields =
  '[ "name" >: Required Text
   , "age"  >: Optional Int
   ]

person :: PersonParams
person
   = #name @= Required "alice"
  <: #age  @= Optional (Just 21)
  <: nil

type PersonRequiredParams =
  RecordOf Required
  '[ "name" >: Text
   ]

class Associate (AssocKey kv) (f (AssocValue kv)) xs => ElemF xs f kv where
  elemF :: proxy kv -> Record xs -> f (AssocValue kv)

liftRecord :: forall f xs ys . Forall (ElemF xs f) ys => Record xs -> RecordOf f ys
liftRecord r =
  htabulateFor (Proxy :: Proxy (ElemF xs f)) $ \m -> Field $ elemF m r

instance ElemF PersonParamsFields Required ("name" >: Text) where
  elemF _ r = r ^. #name