HigherKindedDataUpdate.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}

module HKD where

import GHC.Generics
import Data.Generic.HKD
import Data.Aeson
import Data.Maybe
import Data.Barbie
import Data.Functor.Identity

data Contact = Contact
  { name :: String
  , address :: String
  } deriving (Eq, Generic, Show)

type MaybeContact = HKD Contact Maybe

instance FromJSON Contact
instance FromJSON MaybeContact

-- | Update fields in an Identity HKD with Just values from a Maybe HKD
update :: (ProductB b) => b Identity -> b Maybe -> b Identity
update initial update = bzipWith f initial update
  where
    f i u = flip fromMaybe u <$> i

-- | Convenience function to avoid manual Identity wrapping
updateUnwrapped d x = runIdentity . construct $ update (deconstruct @Identity d) x

initialContact = Contact "Matthew" "home"

contactUpdate :: MaybeContact
contactUpdate = fromJust $ decode "{\"address\": \"new home\"}"

-- >>> contactUpdate
-- Contact {name = Nothing, address = Just "new home"}

-- >>> updateUnwrapped initialContact contactUpdate
-- Contact {name = "Matthew", address = "new home"}