Created
August 25, 2021 20:40
-
-
Save spencerjanssen/b378e02d6428822abbfa900323c896da to your computer and use it in GitHub Desktop.
ModifyFields
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# 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