I'm trying to write HTML form helpers where I'd like the call-sites to support both of the following use-cases:
{-# LANGUAGE AllowAmbiguousTypes, DataKinds, OverloadedStrings #-}
import Data.Proxy
import Data.Text as Text
import GHC.Generics
import GHC.Records
import GHC.TypeLits
data FormCtx obj = FormCtx { ctxFieldNamePrefix :: !Text, ctxObject :: !obj }
data MyRecord = MyRecord { field1 :: !Text, field2 :: !Text } deriving (Generic)
-- USE-CASE #1
let ctx = FormCtx "MyRecord" obj
in (fieldNameFor @"field1" ctx, fieldValueFor @"field1" ctx)
-- USE-CASE #2 -- with a (Maybe obj)
let ctx = FormCtx "MyRecord" (Just obj)
in (fieldNameFor @"field1" ctx, fieldValueFor @"field1" ctx)
-- Implementation for fieldNameFor which works only
-- with `obj`, and not `Maybe obj`
fieldNameFor :: forall k obj a . (KnownSymbol k, HasField k obj a) => FormCtx obj -> Text
fieldNameFor FormCtx {ctxFieldNamePrefix} = ctxFieldNamePrefix <> "[" <> (Text.pack $ symbolVal (Proxy @k)) <> "]"
-- Implementation for fieldValueFor which works only
-- with `obj`, and not `Maybe obj`
fieldValueFor :: forall k obj a . (KnownSymbol k, HasField k obj a) => FormCtx obj -> a
fieldValueFor FormCtx {ctxObject} = getField @k ctxObject
I've tried defining a type-classs, called FieldNameFor
to be able to define overlapping instances for obj
and Maybe obj
but I'm unable to make it work with the KnownSymbol k, HasField k obj a
typeclass constrains that are required for getField
to work.
This isn't very pretty, but it works. Just replace your existing fieldValueFor
with it:
{-# LANGUAGE TypeFamilies #-}
type family CopyMaybe a b where
CopyMaybe (Maybe a) b = Maybe b
CopyMaybe a b = b
class FieldValueFor k obj a where
fieldValueFor :: FormCtx obj -> CopyMaybe obj a
instance {-# OVERLAPPABLE #-} (KnownSymbol k, HasField k obj a, CopyMaybe obj a ~ a) => FieldValueFor k obj a where
fieldValueFor FormCtx {ctxObject} = getField @k ctxObject
instance (KnownSymbol k, HasField k obj a) => FieldValueFor k (Maybe obj) a where
fieldValueFor FormCtx {ctxObject} = getField @k <$> ctxObject
For fieldNameFor
it's even simpler: just remove the HasField k obj a
constraint (it was redundant all along), and then your existing implementation will work.