diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,17 @@ +5.3.3 [2024.12.28] +------------------ +* Add `makeFieldsId`, which generates overloaded field accessors using the + same names as the underlying fields. This is intended for use with the + `NoFieldSelectors` and `DuplicateRecordFields` language extensions. + + Also add `classIdFields :: LensRules` and `classIdNamer :: FieldNamer`, both + of which use the same naming rules as `makeFieldsId`. +* Update the `Prism`s in `Language.Haskell.TH.Lens` to reflect additions to + `template-haskell-2.23.0.0`: + * Add an `_OrP` `Prism` for the `Pat` data type. + * Add `_ForallE`, `_ForallVisE`, and `_ConstrainedE` `Prism`s for the `Exp` + data type. + 5.3.2 [2024.05.12] ------------------ * Define the following lenses that perform an operation and result the old diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -9,7 +9,7 @@ The [FAQ](https://github.com/ekmett/lens/wiki/FAQ), which provides links to a large number of different resources for learning about lenses and an overview of the [derivation](https://github.com/ekmett/lens/wiki/Derivation) of these types can be found on the [Lens Wiki](https://github.com/ekmett/lens/wiki) along with a brief [overview](https://github.com/ekmett/lens/wiki/Overview) and some [examples](https://github.com/ekmett/lens/wiki/Examples). -Documentation is available through [github](http://ekmett.github.com/lens/frames.html) (for HEAD) or [hackage](http://hackage.haskell.org/package/lens) for the current and preceding releases. +Documentation is available through [github](https://ekmett.github.io/lens/frames.html) (for HEAD) or [hackage](http://hackage.haskell.org/package/lens) for the current and preceding releases. Field Guide ----------- diff --git a/cabal.project b/cabal.project --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,17 @@ packages: . ./examples ./lens-properties + +-- TODO: Remove this once the ecosystem has caught up with GHC 9.12 +allow-newer: + aeson:ghc-prim, + aeson:template-haskell, + binary-orphans:base, + boring:base, + indexed-traversable:base, + indexed-traversable-instances:base, + integer-conversion:base, + microstache:base, + semialign:base, + these:base, + uuid-types:template-haskell diff --git a/examples/lens-examples.cabal b/examples/lens-examples.cabal --- a/examples/lens-examples.cabal +++ b/examples/lens-examples.cabal @@ -25,13 +25,14 @@ , GHC == 9.0.2 , GHC == 9.2.8 , GHC == 9.4.8 - , GHC == 9.6.4 + , GHC == 9.6.6 , GHC == 9.8.2 , GHC == 9.10.1 + , GHC == 9.12.1 source-repository head type: git - location: git://github.com/ekmett/lens.git + location: https://github.com/ekmett/lens.git flag pong default: True diff --git a/lens-properties/lens-properties.cabal b/lens-properties/lens-properties.cabal --- a/lens-properties/lens-properties.cabal +++ b/lens-properties/lens-properties.cabal @@ -22,9 +22,10 @@ , GHC == 9.0.2 , GHC == 9.2.8 , GHC == 9.4.8 - , GHC == 9.6.4 + , GHC == 9.6.6 , GHC == 9.8.2 , GHC == 9.10.1 + , GHC == 9.12.1 extra-source-files: .hlint.yaml @@ -32,7 +33,7 @@ source-repository head type: git - location: git://github.com/ekmett/lens.git + location: https://github.com/ekmett/lens.git library build-depends: diff --git a/lens.cabal b/lens.cabal --- a/lens.cabal +++ b/lens.cabal @@ -1,6 +1,6 @@ name: lens category: Data, Lenses, Generics -version: 5.3.2 +version: 5.3.3 license: BSD2 cabal-version: 1.18 license-file: LICENSE @@ -21,9 +21,10 @@ , GHC == 9.0.2 , GHC == 9.2.8 , GHC == 9.4.8 - , GHC == 9.6.4 + , GHC == 9.6.6 , GHC == 9.8.2 , GHC == 9.10.1 + , GHC == 9.12.1 synopsis: Lenses, Folds and Traversals description: This package comes \"Batteries Included\" with many useful lenses for the types @@ -36,7 +37,7 @@ . An overview, with a large number of examples can be found in the . . - An introductory video on the style of code used in this library by Simon Peyton Jones is available from . + An introductory video on the style of code used in this library by Simon Peyton Jones is available from . . A video on how to use lenses and how they are constructed is available on . . @@ -189,7 +190,7 @@ filepath >= 1.2.0.0 && < 1.6, free >= 5.1.5 && < 6, ghc-prim, - hashable >= 1.2.7.0 && < 1.5, + hashable >= 1.2.7.0 && < 1.6, indexed-traversable >= 0.1 && < 0.2, indexed-traversable-instances >= 0.1 && < 0.2, kan-extensions >= 5 && < 6, @@ -200,7 +201,7 @@ semigroupoids >= 5.0.1 && < 7, strict >= 0.4 && < 0.6, tagged >= 0.8.6 && < 1, - template-haskell >= 2.11.1.0 && < 2.22, + template-haskell >= 2.11.1.0 && < 2.24, text >= 1.2.3.0 && < 2.2, th-abstraction >= 0.4.1 && < 0.8, these >= 1.1.1.1 && < 1.3, @@ -333,6 +334,9 @@ T799 T917 T972 + if impl(ghc >= 9.2) + other-modules: + T1024 ghc-options: -Wall -threaded hs-source-dirs: tests default-language: Haskell2010 @@ -399,7 +403,7 @@ hs-source-dirs: tests default-language: Haskell2010 - build-depends: base, deepseq, simple-reflect >= 0.3.1 + build-depends: base <5, deepseq, simple-reflect >= 0.3.1 -- Basic benchmarks for the uniplate-style combinators benchmark plated diff --git a/src/Control/Exception/Lens.hs b/src/Control/Exception/Lens.hs --- a/src/Control/Exception/Lens.hs +++ b/src/Control/Exception/Lens.hs @@ -676,13 +676,18 @@ -- | This t'Exception' contains provides information about what assertion failed in the 'String'. -- - -- >>> handling _AssertionFailed (\ xs -> "caught" <$ guard ("" `isInfixOf` xs) ) $ assert False (return "uncaught") - -- "caught" - -- -- @ -- '_AssertionFailed' :: 'Prism'' 'AssertionFailed' 'String' -- '_AssertionFailed' :: 'Prism'' 'SomeException' 'String' -- @ + + {- + TODO: This doctest is temporarily disabled, as it does not work properly on + GHC 9.12. See https://gitlab.haskell.org/ghc/ghc/-/issues/25610. + + -- >>> handling _AssertionFailed (\ xs -> "caught" <$ guard ("" `isInfixOf` xs) ) $ assert False (return "uncaught") + -- "caught" + -} _AssertionFailed :: Prism' t String _AssertionFailed = __AssertionFailed._AssertionFailed {-# INLINE _AssertionFailed #-} diff --git a/src/Control/Lens/Cons.hs b/src/Control/Lens/Cons.hs --- a/src/Control/Lens/Cons.hs +++ b/src/Control/Lens/Cons.hs @@ -330,7 +330,7 @@ _tail = _Cons._2 {-# INLINE _tail #-} --- | Modify the target of a 'Cons' value by using @('<|')@. +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' using @('<|')@. -- -- >>> (["world"], ["lens"]) & _1 <|~ "hello" -- (["hello","world"],["lens"]) @@ -338,37 +338,35 @@ l <|~ n = over l (n <|) {-# INLINE (<|~) #-} --- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('<|')@. +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' using @('<|')@. (<|=) :: (MonadState s m, Cons b b a a) => ASetter s s b b -> a -> m () l <|= a = State.modify (l <|~ a) {-# INLINE (<|=) #-} --- | ('<|') a 'Cons' value onto the end of the target of a 'Lens' and --- return the result. +-- | ('<|') a value onto the target of a 'Lens' and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Cons.<|~') is more flexible. (<<|~) :: Cons b b a a => LensLike ((,) b) s t b b -> a -> s -> (b, t) l <<|~ m = l <%~ (m <|) {-# INLINE (<<|~) #-} --- | ('<|') a 'Cons' value onto the end of the target of a 'Lens' and --- return the /old/ result. +-- | ('<|') a value onto the target of a 'Lens' and return the /old/ result. -- -- When you do not need the result of the operation, ('Control.Lens.Cons.<|~') is more flexible. (<<<|~) :: Cons b b a a => LensLike' ((,) b) s b -> a -> s -> (b, s) l <<<|~ m = l <<%~ (m <|) {-# INLINE (<<<|~) #-} --- | ('<|') a 'Semigroup' value onto the end of the target of a 'Lens' into --- your 'Monad''s state and return the result. +-- | ('<|') a value onto the target of a 'Lens' into your 'Monad'\'s state and +-- return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Cons.<|=') is more flexible. (<<|=) :: (MonadState s m, Cons b b a a) => LensLike ((,) b) s s b b -> a -> m b l <<|= r = l <%= (r <|) {-# INLINE (<<|=) #-} --- | ('<|') a 'Semigroup' value onto the end of the target of a 'Lens' into --- your 'Monad''s state and return the /old/ result. +-- | ('<|') a value onto the target of a 'Lens' into your 'Monad'\'s state and +-- return the /old/ result. -- -- When you do not need the result of the operation, ('Control.Lens.Cons.<|=') is more flexible. (<<<|=) :: (MonadState s m, Cons b b a a) => LensLike ((,) b) s s b b -> a -> m b @@ -544,7 +542,7 @@ _last = _Snoc._2 {-# INLINE _last #-} --- | 'snoc' an element onto the end of a container. +-- | 'snoc' an element onto a container. -- -- This is an infix alias for 'snoc'. -- @@ -560,7 +558,7 @@ (|>) = curry (simply review _Snoc) {-# INLINE (|>) #-} --- | 'snoc' an element onto the end of a container. +-- | 'snoc' an element onto a container. -- -- >>> snoc (Seq.fromList []) a -- fromList [a] @@ -591,7 +589,7 @@ unsnoc = simply preview _Snoc {-# INLINE unsnoc #-} --- | Modify the target of a 'Cons' value by using @('|>')@. +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' using @('|>')@. -- -- >>> (["world"], ["lens"]) & _1 |>~ "hello" -- (["world","hello"],["lens"]) @@ -599,37 +597,35 @@ l |>~ n = over l (|> n) {-# INLINE (|>~) #-} --- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('|>')@. +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' using @('|>')@. (|>=) :: (MonadState s m, Snoc b b a a) => ASetter s s b b -> a -> m () l |>= a = State.modify (l |>~ a) {-# INLINE (|>=) #-} --- | ('|>') a 'Cons' value onto the end of the target of a 'Lens' and --- return the result. +-- | ('|>') a value onto the target of a 'Lens' and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Cons.|>~') is more flexible. (<|>~) :: Snoc b b p p => LensLike ((,) b) s t b b -> p -> s -> (b, t) l <|>~ m = l <%~ (|> m) {-# INLINE (<|>~) #-} --- | ('|>') a 'Cons' value onto the end of the target of a 'Lens' and --- return the /old/ result. +-- | ('|>') a value onto the target of a 'Lens' and return the /old/ result. -- -- When you do not need the result of the operation, ('Control.Lens.Cons.|>~') is more flexible. (<<|>~) :: Snoc b b p p => LensLike' ((,) b) s b -> p -> s -> (b, s) l <<|>~ m = l <<%~ (|> m) {-# INLINE (<<|>~) #-} --- | ('|>') a 'Semigroup' value onto the end of the target of a 'Lens' into --- your 'Monad''s state and return the result. +-- | ('|>') a value onto the target of a 'Lens' into your 'Monad'\'s state and +-- return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Cons.|>=') is more flexible. (<|>=) :: (MonadState s m, Snoc b b p p) => LensLike ((,) b) s s b b -> p -> m b l <|>= r = l <%= (|> r) {-# INLINE (<|>=) #-} --- | ('|>') a 'Semigroup' value onto the end of the target of a 'Lens' into --- your 'Monad''s state and return the result. +-- | ('|>') a value onto the target of a 'Lens' into your 'Monad'\'s state and +-- return the /old/ result. -- -- When you do not need the result of the operation, ('Control.Lens.Cons.|>=') is more flexible. (<<|>=) :: (MonadState s m, Snoc b b p p) => LensLike ((,) b) s s b b -> p -> m b diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs --- a/src/Control/Lens/TH.hs +++ b/src/Control/Lens/TH.hs @@ -28,6 +28,7 @@ , makeClassy, makeClassyFor, makeClassy_ , makeFields , makeFieldsNoPrefix + , makeFieldsId -- ** Prisms , makePrisms , makeClassyPrisms @@ -58,6 +59,7 @@ , classUnderscoreNoPrefixFields , underscoreFields , abbreviatedFields + , classIdFields -- ** LensRules configuration accessors , lensField , FieldNamer @@ -78,6 +80,7 @@ , classUnderscoreNoPrefixNamer , underscoreNamer , abbreviatedNamer + , classIdNamer ) where import Prelude () @@ -634,6 +637,19 @@ methodName = fieldUnprefixed return (MethodName (mkName className) (mkName methodName)) +-- | Field rules for fields whose names are to be used verbatim, with no +-- prefixes, no underscores, no transformations of any kind. +classIdFields :: LensRules +classIdFields = + defaultFieldRules & lensField .~ classIdNamer + +-- | A 'FieldNamer' for 'classIdFields'. +classIdNamer :: FieldNamer +classIdNamer _ _ field = [MethodName (mkName className) (mkName fieldName)] + where + fieldName = nameBase field + className = "Has" ++ overHead toUpper fieldName + -- | Field rules fields in the form @ prefixFieldname or _prefixFieldname @ -- If you want all fields to be lensed, then there is no reason to use an @_@ before the prefix. -- If any of the record fields leads with an @_@ then it is assume a field without an @_@ should not have a lens created. @@ -743,6 +759,42 @@ -- @ makeFieldsNoPrefix :: Name -> DecsQ makeFieldsNoPrefix = makeFieldOptics classUnderscoreNoPrefixFields + +-- | Generate overloaded field accessors, using exactly the same names as the +-- underlying fields. Intended for use with the @NoFieldSelectors@ and +-- @DuplicateRecordFields@ language extensions. +-- +-- As an example: +-- +-- @ +-- data Foo a = Foo { x :: 'Int', y :: a } +-- newtype Bar = Bar { x :: 'Char' } +-- makeFieldsId ''Foo +-- makeFieldsId ''Bar +-- @ +-- +-- will create classes +-- +-- @ +-- class HasX s a | s -> a where +-- x :: Lens' s a +-- class HasY s a | s -> a where +-- y :: Lens' s a +-- @ +-- +-- together with instances +-- +-- @ +-- instance HasX (Foo a) Int +-- instance HasY (Foo a) a where +-- instance HasX Bar Char where +-- @ +-- +-- @ +-- makeFieldsId = 'makeLensesWith' 'classIdFields' +-- @ +makeFieldsId :: Name -> DecsQ +makeFieldsId = makeFieldOptics classIdFields defaultFieldRules :: LensRules defaultFieldRules = LensRules diff --git a/src/Language/Haskell/TH/Lens.hs b/src/Language/Haskell/TH/Lens.hs --- a/src/Language/Haskell/TH/Lens.hs +++ b/src/Language/Haskell/TH/Lens.hs @@ -281,6 +281,11 @@ #if MIN_VERSION_template_haskell(2,22,0) , _TypeE #endif +#if MIN_VERSION_template_haskell(2,23,0) + , _ForallE + , _ForallVisE + , _ConstrainedE +#endif -- ** Body Prisms , _GuardedB , _NormalB @@ -338,6 +343,9 @@ , _TypeP , _InvisP #endif +#if MIN_VERSION_template_haskell(2,23,0) + , _OrP +#endif -- ** Type Prisms , _ForallT , _AppT @@ -2137,6 +2145,32 @@ remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,23,0) +_ForallE :: Prism' Exp ([TyVarBndr Specificity], Exp) +_ForallE + = prism' reviewer remitter + where + reviewer (x, y) = ForallE x y + remitter (ForallE x y) = Just (x, y) + remitter _ = Nothing + +_ForallVisE :: Prism' Exp ([TyVarBndr ()], Exp) +_ForallVisE + = prism' reviewer remitter + where + reviewer (x, y) = ForallVisE x y + remitter (ForallVisE x y) = Just (x, y) + remitter _ = Nothing + +_ConstrainedE :: Prism' Exp ([Exp], Exp) +_ConstrainedE + = prism' reviewer remitter + where + reviewer (x, y) = ConstrainedE x y + remitter (ConstrainedE x y) = Just (x, y) + remitter _ = Nothing +#endif + _GuardedB :: Prism' Body [(Guard, Exp)] _GuardedB = prism' reviewer remitter @@ -2501,6 +2535,16 @@ where reviewer = InvisP remitter (InvisP x) = Just x + remitter _ = Nothing +#endif + +#if MIN_VERSION_template_haskell(2,23,0) +_OrP :: Prism' Pat (NonEmpty Pat) +_OrP + = prism' reviewer remitter + where + reviewer = OrP + remitter (OrP x) = Just x remitter _ = Nothing #endif diff --git a/tests/T1024.hs b/tests/T1024.hs new file mode 100644 --- /dev/null +++ b/tests/T1024.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances #-} + +-- | Test 'makeFieldsId', which requires NoFieldSelectors and +-- DuplicateRecordFields. This test consequently only works on GHC >= 9.2. +module T1024 where + +import Control.Lens + +data Taco = Taco + { hardShell :: Bool + , sauce :: Int + , filling :: String + } +data Burrito = Burrito + { sauce :: Int + , filling :: String + } +makeFieldsId ''Taco +makeFieldsId ''Burrito + +checkTacoHardShell :: Lens' Taco Bool +checkTacoHardShell = hardShell + +checkBurritoFilling :: Lens' Burrito String +checkBurritoFilling = filling