Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
lift `Record xs` to `RecordOf h ys`
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment