Skip to content

Instantly share code, notes, and snippets.

@spencerjanssen
Created August 25, 2021 20:40
Show Gist options
  • Save spencerjanssen/b378e02d6428822abbfa900323c896da to your computer and use it in GitHub Desktop.
Save spencerjanssen/b378e02d6428822abbfa900323c896da to your computer and use it in GitHub Desktop.
ModifyFields
{-# 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment