CODEWITHSUNDEEP
haskellrecordtypeclass
Saurabh Nanda
Saurabh Nanda

Reputation: 6793

How to write a Haskell function that can call "getField @k" on "obj" as well as "Maybe obj"

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.

Upvotes: 1

Views: 103

Answers (1)

Joseph Sible-Reinstate Monica
Joseph Sible-Reinstate Monica

Reputation: 48592

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.

Upvotes: 1

Related Questions