ModifyFields

ModifyFields.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

import Data.Kind (Type)
import GHC.Generics (K1, M1, Meta (MetaSel), R, S, (:*:))
import GHC.TypeLits (Symbol)
import Generic.Data.Microsurgery (GSurgery, Generically (..), Surgery, Surgery' (..))

-- | @ModifyFields strategies t@ applies each strategy in the list @strategies@ to the 'Generic'
-- representation of @t@, producing a new type which may have different type class instances from
-- @t@.
--
-- For example:
--
-- @
-- data Example = Example {x :: Int, y :: [Text]}
--     deriving (Generic)
--     deriving
--         (SomeClass)
--         via ( 'ModifyFields'
--                 '[ 'AtField' "x" ('Rename' "a")
--                  , 'AtField' "y" ('Coerce' (ViaJSON [Text]))
--                  ]
--                 Example
--             )
-- @
type ModifyFields t a = Surgery (AtFields t) a

-- | Strategy to coerce one type to another.  Only use types which are 'Coercible' such as newtypes.
type Coerce :: Type -> Type
data Coerce a

-- | Strategy to change the name of a record field.
type Rename :: Symbol -> Type
data Rename s

type AtFields :: [Type] -> Type
data AtFields s

-- | @AtField l strat@ apply a strategy @strat@ to selector @l@.
type AtField :: Symbol -> Type -> Type
data AtField s strat

type instance GSurgery (AtFields '[]) f = f
type instance GSurgery (AtFields (AtField l strat : strats)) f = GSurgery (AtFields strats) (ApplyAtField l strat f)

-- | @ApplyAtField l strat f@ applies the strategy @strat@ at the selector named @l@ in the
-- 'Generic' representation @f@.
type ApplyAtField :: Symbol -> Type -> (Type -> Type) -> (Type -> Type)
type family ApplyAtField l strat f where
    ApplyAtField l strat (M1 S ( 'MetaSel ( 'Just l) y z w) f) = ApplyStrat strat (M1 S ( 'MetaSel ( 'Just l) y z w) f)
    ApplyAtField l strat (M1 S sel f) = M1 S sel f
    ApplyAtField l strat (M1 x t f) = M1 x t (ApplyAtField l strat f)
    ApplyAtField l strat (f :*: g) = ApplyAtField l strat f :*: ApplyAtField l strat g

-- | Apply a strategy at a record selector
type ApplyStrat :: Type -> (Type -> Type) -> (Type -> Type)
type family ApplyStrat strat f where
    ApplyStrat (Rename lbl) (M1 S ( 'MetaSel ( 'Just _) y z w) f) = M1 S ( 'MetaSel ( 'Just lbl) y z w) f
    ApplyStrat (Coerce t) (M1 S m (K1 R _)) = M1 S m (K1 R t)