Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add support for gafield as a label in GHC >= 9.6 #501

Merged
merged 2 commits into from
Aug 9, 2024
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 8 additions & 0 deletions optics-core/src/Optics/Generic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -176,6 +176,14 @@ instance (a ~ Void0, b ~ Void0) => GField name Void0 Void0 a b where
-- ...In the...
-- ...
--
-- /Note:/ 'gafield' is supported by 'Optics.Label.labelOptic' and can be used
-- with a concise syntax via @OverloadedLabels@ with GHC >= 9.6.
--
-- @
-- λ> herring ^? #"?name"
-- Just \"Henry\"
-- @
--
-- @since 0.4
--
class GAffineField (name :: Symbol) s t a b | name s -> t a b
Expand Down
14 changes: 11 additions & 3 deletions optics-core/src/Optics/Label.hs
Original file line number Diff line number Diff line change
Expand Up @@ -535,7 +535,9 @@ type GenericLabelOpticContext repDefined name k s t a b =
, Unless repDefined (NoLabelOpticError name k s t a b)
, k ~ If (CmpSymbol "_@" name == 'LT && CmpSymbol "_[" name == 'GT)
A_Prism
A_Lens
(If (CmpSymbol "?`" name == 'LT && CmpSymbol "?{" name == 'GT)
phadej marked this conversation as resolved.
Show resolved Hide resolved
An_AffineTraversal
A_Lens)
, GenericOptic repDefined name k s t a b
, Dysfunctional name k s t a b
)
Expand Down Expand Up @@ -593,10 +595,16 @@ instance
) => GenericOptic repDefined name A_Lens s t a b where
genericOptic = gfieldImpl @name

instance
( GAffineFieldImpl repDefined name s t a b
, origName ~ AppendSymbol "?" name
) => GenericOptic repDefined origName An_AffineTraversal s t a b where
genericOptic = gafieldImpl @repDefined @name

instance
( GConstructorImpl repDefined name s t a b
, _name ~ AppendSymbol "_" name
) => GenericOptic repDefined _name A_Prism s t a b where
, origName ~ AppendSymbol "_" name
) => GenericOptic repDefined origName A_Prism s t a b where
genericOptic = gconstructorImpl @repDefined @name

----------------------------------------
Expand Down
9 changes: 9 additions & 0 deletions optics/tests/Optics/Tests/Labels/Generic.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
Expand Down Expand Up @@ -90,7 +91,11 @@ label4rhs s b = s { fish = case fish s of
}

label5lhs, label5rhs :: Human Mammal -> Bool -> Human Mammal
#if __GLASGOW_HASKELL__ >= 906
label5lhs s b = set (#pets % traversed % #"?lazy") b s
#else
label5lhs s b = set (#pets % traversed % gafield @"lazy") b s
#endif
label5rhs s b = s { pets = (`map` pets s) $ \case
Dog name0 age0 -> Dog { name = name0, age = age0 }
Cat name0 age0 _ -> Cat { name = name0, age = age0, lazy = b }
Expand Down Expand Up @@ -152,7 +157,11 @@ howManyGoldFish :: Int
howManyGoldFish = lengthOf (#pets % folded % #_GoldFish) humanWithFish

hasLazyPets :: Bool
#if __GLASGOW_HASKELL__ >= 906
hasLazyPets = orOf (#pets % folded % #"?lazy") human
phadej marked this conversation as resolved.
Show resolved Hide resolved
#else
hasLazyPets = orOf (#pets % folded % gafield @"lazy") human
#endif

yearLater :: Human Mammal
yearLater = human & #age %~ (+1)
Expand Down
Loading