optics 0.4 → 0.4.1
raw patch · 10 files changed
+119/−69 lines, 10 filesdep +tasty-benchdep −criteriondep ~optics-coredep ~optics-extradep ~optics-thnew-uploader
Dependencies added: tasty-bench
Dependencies removed: criterion
Dependency ranges changed: optics-core, optics-extra, optics-th
Files
- CHANGELOG.md +11/−0
- benchmarks/folds.hs +2/−4
- benchmarks/traversals.hs +2/−5
- optics.cabal +45/−17
- src/Optics.hs +3/−8
- tests/Optics/Tests/Core.hs +13/−9
- tests/Optics/Tests/Eta.hs +1/−1
- tests/Optics/Tests/Labels/Generic.hs +2/−11
- tests/Optics/Tests/Labels/TH.hs +0/−6
- tests/Optics/Tests/Utils.hs +40/−8
CHANGELOG.md view
@@ -1,3 +1,14 @@+# optics-0.4.1 (2022-03-22)+* Add support for GHC-9.2+* Add `is` ([#410](https://github.com/well-typed/optics/pull/410))+* Improve error messages related to the `JoinKinds` class+ ([#439](https://github.com/well-typed/optics/pull/439))+* Port `universeOf`, `cosmosOf`, `paraOf`, `rewriteOf`, `transformOf`,+ `rewriteMOf` and `transformMOf` from `Control.Lens.Plated`+ ([#379](https://github.com/well-typed/optics/pull/379))+* Add `(%?)` composition operator+ ([#434](https://github.com/well-typed/optics/pull/434))+ # optics-0.4 (2021-02-22) * See [migration-guide-0.4.md](https://github.com/well-typed/optics/blob/master/migration-guide-0.4.md) for more details * Add support for GHC-9.0
benchmarks/folds.hs view
@@ -1,7 +1,6 @@ module Main where -import Criterion.Main-import Criterion.Types+import Test.Tasty.Bench import qualified Control.Lens as L import qualified Data.ByteString.Lens as L import qualified Data.ByteString as BS@@ -18,7 +17,7 @@ import Optics main :: IO ()-main = defaultMainWith config+main = defaultMain [ bgroup "vector" [ bgroup "toList" [ bench "native" $ nf V.toList v@@ -197,7 +196,6 @@ ] ] where- config = defaultConfig { timeLimit = 1 } l = [0..10000] :: [Int] b = BS.pack $ map fromIntegral l bl = BSL.pack $ map fromIntegral [0..1000000::Int]
benchmarks/traversals.hs view
@@ -1,8 +1,7 @@ module Main where -import Criterion.Main-import Criterion.Types import Data.Char+import Test.Tasty.Bench import qualified Control.Lens as L import qualified Control.Lens.Unsound as L import qualified Control.Monad.Trans.State as S@@ -22,7 +21,7 @@ import Optics main :: IO ()-main = defaultMainWith config+main = defaultMain [ bgroup "vector" [ bgroup "traverse" [ bench "native" $@@ -456,8 +455,6 @@ ] ] where- config = defaultConfig { timeLimit = 1 }- l = [0..10000] :: [Int] {-# NOINLINE l #-} xl = [0..100000] :: [Int]
optics.cabal view
@@ -1,12 +1,13 @@+cabal-version: 2.2 name: optics-version: 0.4-license: BSD3+version: 0.4.1+license: BSD-3-Clause license-file: LICENSE build-type: Simple maintainer: optics@well-typed.com author: Adam Gundry, Andres Löh, Andrzej Rybczak, Oleg Grenrus-cabal-version: 1.24-tested-with: ghc ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.3, GHCJS ==8.4+tested-with: GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7+ || ==9.0.2 || ==9.2.2, GHCJS ==8.4 synopsis: Optics as an abstract interface category: Data, Optics, Lenses description:@@ -33,18 +34,48 @@ location: https://github.com/well-typed/optics.git subdir: optics +common language+ ghc-options: -Wall -Wcompat++ default-language: Haskell2010++ default-extensions: BangPatterns+ ConstraintKinds+ DefaultSignatures+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ EmptyCase+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ OverloadedLabels+ PatternSynonyms+ RankNTypes+ ScopedTypeVariables+ TupleSections+ TypeApplications+ TypeFamilies+ TypeOperators+ ViewPatterns+ library- default-language: Haskell2010+ import: language hs-source-dirs: src- ghc-options: -Wall build-depends: base >= 4.10 && <5 , array >= 0.5.2.0 && <0.6 , containers >= 0.5.10.2 && <0.7 , mtl >= 2.2.2 && <2.3- , optics-core >= 0.4 && <0.4.1- , optics-extra >= 0.4 && <0.4.1- , optics-th >= 0.4 && <0.4.1+ , optics-core >= 0.4.1 && <0.4.2+ , optics-extra >= 0.4.1 && <0.4.2+ , optics-th >= 0.4.1 && <0.4.2 , transformers >= 0.5 && <0.6 -- main module to land with repl@@ -124,9 +155,8 @@ , Numeric.Optics test-suite optics-tests- default-language: Haskell2010+ import: language hs-source-dirs: tests- ghc-options: -Wall -- inspection-testing doesn't compile with GHCJS if impl(ghcjs)@@ -160,9 +190,8 @@ -- Benchmarking folds benchmark folds- default-language: Haskell2010+ import: language hs-source-dirs: benchmarks- ghc-options: -Wall -threaded -- GHCJS takes forever to compile dependencies if impl(ghcjs)@@ -171,9 +200,9 @@ build-depends: base , bytestring , containers- , criterion , lens , optics+ , tasty-bench , unordered-containers , vector @@ -182,9 +211,8 @@ -- Benchmarking traversals benchmark traversals- default-language: Haskell2010+ import: language hs-source-dirs: benchmarks- ghc-options: -Wall -threaded -- GHCJS takes forever to compile dependencies if impl(ghcjs)@@ -193,9 +221,9 @@ build-depends: base , bytestring , containers- , criterion , lens , optics+ , tasty-bench , transformers , unordered-containers , vector
src/Optics.hs view
@@ -528,13 +528,10 @@ -- generates a type error if the composition does not make sense. -- -- The optic kind resulting from a composition is the least upper bound (join)--- of the optic kinds being composed, if it exists. The 'Join' type family+-- of the optic kinds being composed, if it exists. The 'JoinKinds' class -- computes the least upper bound given two optic kind tags. For example the--- 'Join' of a 'Lens' and a 'Prism' is an 'AffineTraversal'.------ >>> let res :: JoinKinds A_Lens A_Prism k => Proxy k; res = Proxy--- >>> :t res--- res :: Proxy An_AffineTraversal+-- constraint 'JoinKinds A_Lens A_Prism k' makes GHC infer that @k@ must be+-- 'An_AffineTraversal'. -- -- The join does not exist for some pairs of optic kinds, which means that they -- cannot be composed. For example there is no optic kind above both 'Setter'@@ -995,11 +992,9 @@ -- +--------------+-----------------+-------------------------------------------+------------------------------+-------------------------------+-------------------------------------------+ -- $setup--- >>> :set -XFlexibleContexts -- >>> import Control.Monad.Reader -- >>> import Control.Monad.State -- >>> import Data.Functor.Identity--- >>> import Data.Proxy -- >>> import qualified Data.IntSet as IntSet -- >>> import qualified Data.Map as Map -- >>> import Optics.State.Operators
tests/Optics/Tests/Core.hs view
@@ -40,7 +40,7 @@ , testCase "optimized rhs05" $ assertSuccess $(inspectTest $ hasNoProfunctors 'rhs05) , testCase "traverseOf_ (_Left % itraversed % _1 % ifolded) = traverseOf_ ..." $- -- GHC >= 8.6 gives different order of let bindings+ -- GHC >= 8.6 gives different structure of let bindings. ghcGE86failure $(inspectTest $ 'lhs06 === 'rhs06) , testCase "optimized lhs06" $ assertSuccess $(inspectTest $ hasNoProfunctors 'lhs06)@@ -60,15 +60,15 @@ , testCase "optimized rhs08a" $ assertSuccess $(inspectTest $ hasNoProfunctors 'rhs08a) , testCase "iover (imapped <% imapped) = iover (imapped % mapped)" $- -- GHC 9.0.1 splits the rhs into two bindings- ghc90failure $(inspectTest $ 'lhs09 === 'rhs09)+ -- GHC 9.* applies a worker-wrapper transformation to the RHS.+ ghcGE90failure $(inspectTest $ 'lhs09 === 'rhs09) , testCase "optimized lhs09" $ assertSuccess $(inspectTest $ hasNoProfunctors 'lhs09) , testCase "optimized rhs09" $ assertSuccess $(inspectTest $ hasNoProfunctors 'rhs09) , testCase "itraverseOf_ itraversed = itraverseOf_ ifolded" $- -- GHC 8.2 gives a different order of let bindings- ghc82failure $(inspectTest $ 'lhs10 === 'rhs10)+ -- GHC 8.2, 8.6 to 8.10 and 9.2 give a different structure of let bindings.+ ghc82and86to810and92failure $(inspectTest $ 'lhs10 === 'rhs10) , testCase "optimized lhs10a" $ assertSuccess $(inspectTest $ hasNoProfunctors 'lhs10a) , testCase "optimized rhs10a" $@@ -80,7 +80,8 @@ , testCase "optimized rhs11" $ assertSuccess $(inspectTest $ hasNoProfunctors 'rhs11) , testCase "traverseOf_ traversed = traverseOf_ folded" $- assertSuccess $(inspectTest $ 'lhs12 === 'rhs12)+ -- GHC 8.6 to 8.10 give a different structure of let bindings.+ ghc86to810failure $(inspectTest $ 'lhs12 === 'rhs12) , testCase "optimized lhs12a" $ assertSuccess $(inspectTest $ hasNoProfunctors 'lhs12a) , testCase "optimized rhs12a" $@@ -92,7 +93,8 @@ , testCase "optimized rhs13" $ assertSuccess $(inspectTest $ hasNoProfunctors 'rhs13) , testCase "traverseOf_ itraversed = traverseOf_ folded" $- assertSuccess $(inspectTest $ 'lhs14 ==- 'rhs14)+ -- GHC 8.6 to 8.10 and GHC 9.2 give a different structure of let bindings.+ ghc86to810and92failure $(inspectTest $ 'lhs14 ==- 'rhs14) , testCase "optimized lhs14a" $ assertSuccess $(inspectTest $ hasNoProfunctors 'lhs14a) , testCase "optimized rhs14a" $@@ -104,13 +106,15 @@ , testCase "optimized rhs15" $ assertSuccess $(inspectTest $ hasNoProfunctors 'rhs15) , testCase "iset (itraversed..) = iset (imapped..)" $- assertSuccess $(inspectTest $ 'lhs16 === 'rhs16)+ -- GHC 8.10 has an intermediate let in the RHS.+ ghc810failure $(inspectTest $ 'lhs16 === 'rhs16) , testCase "optimized lhs16" $ assertSuccess $(inspectTest $ hasNoProfunctors 'lhs16) , testCase "optimized rhs16" $ assertSuccess $(inspectTest $ hasNoProfunctors 'rhs16) , testCase "iset (_1 % itraversed) = iset (_1 % imapped)" $- assertSuccess $(inspectTest $ 'lhs17 === 'rhs17)+ -- GHC 8.10 has an intermediate let in the LHS.+ ghc810failure $(inspectTest $ 'lhs17 === 'rhs17) , testCase "optimized lhs17" $ assertSuccess $(inspectTest $ hasNoProfunctors 'lhs17) , testCase "optimized rhs17" $
tests/Optics/Tests/Eta.hs view
@@ -33,7 +33,7 @@ assertSuccess $(inspectTest $ hasNoProfunctors 'eta5lhs) , testCase "itraverseOf_ ifolded = \\f -> itraverseOf_ ifolded f" $ -- The lhs has more lets which the rhs inlines.- ghc82and90failure $(inspectTest $ 'eta6lhs === 'eta6rhs)+ ghc82andGE90failure $(inspectTest $ 'eta6lhs === 'eta6rhs) , testCase "optimized eta6lhs" $ assertSuccess $(inspectTest $ hasNoProfunctors 'eta6lhs) , testCase "over mapped = \\f -> over mapped f" $
tests/Optics/Tests/Labels/Generic.hs view
@@ -1,15 +1,6 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MonoLocalBinds #-}-{-# LANGUAGE OverloadedLabels #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fplugin=Test.Inspection.Plugin -dsuppress-all #-} module Optics.Tests.Labels.Generic where @@ -95,8 +86,8 @@ label5lhs, label5rhs :: Human Mammal -> Bool -> Human Mammal label5lhs s b = set (#pets % traversed % gafield @"lazy") b s label5rhs s b = s { pets = (`map` pets s) $ \case- Dog name age -> Dog{..}- Cat name age _ -> Cat { lazy = b, .. }+ Dog name0 age0 -> Dog { name = name0, age = age0 }+ Cat name0 age0 _ -> Cat { name = name0, age = age0, lazy = b } } label6lhs, label6rhs :: Human a -> String -> Int -> String -> [b] -> Human b
tests/Optics/Tests/Labels/TH.hs view
@@ -1,11 +1,5 @@-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fplugin=Test.Inspection.Plugin -dsuppress-all #-} module Optics.Tests.Labels.TH where
tests/Optics/Tests/Utils.hs view
@@ -75,6 +75,13 @@ ghc82to86failure = assertSuccess #endif +ghc86to810failure :: Result -> IO ()+#if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ <= 810+ghc86to810failure = assertFailure'+#else+ghc86to810failure = assertSuccess+#endif+ ghc82failure :: Result -> IO () #if __GLASGOW_HASKELL__ == 802 ghc82failure = assertFailure'@@ -82,6 +89,13 @@ ghc82failure = assertSuccess #endif +ghc810failure :: Result -> IO ()+#if __GLASGOW_HASKELL__ == 810+ghc810failure = assertFailure'+#else+ghc810failure = assertSuccess+#endif+ ghcGE86failure :: Result -> IO () #if __GLASGOW_HASKELL__ >= 806 ghcGE86failure = assertFailure'@@ -96,16 +110,34 @@ ghcLE84failure = assertSuccess #endif -ghc82and90failure :: Result -> IO ()-#if __GLASGOW_HASKELL__ == 802 || __GLASGOW_HASKELL__ == 900-ghc82and90failure = assertFailure'+ghc82andGE90failure :: Result -> IO ()+#if __GLASGOW_HASKELL__ == 802 \+ || __GLASGOW_HASKELL__ >= 900+ghc82andGE90failure = assertFailure' #else-ghc82and90failure = assertSuccess+ghc82andGE90failure = assertSuccess #endif -ghc90failure :: Result -> IO ()-#if __GLASGOW_HASKELL__ == 900-ghc90failure = assertFailure'+ghc82and86to810and92failure :: Result -> IO ()+#if __GLASGOW_HASKELL__ == 802 \+ || __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ <= 810 \+ || __GLASGOW_HASKELL__ == 902+ghc82and86to810and92failure = assertFailure' #else-ghc90failure = assertSuccess+ghc82and86to810and92failure = assertSuccess+#endif++ghcGE90failure :: Result -> IO ()+#if __GLASGOW_HASKELL__ >= 900+ghcGE90failure = assertFailure'+#else+ghcGE90failure = assertSuccess+#endif++ghc86to810and92failure :: Result -> IO ()+#if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ <= 810 \+ || __GLASGOW_HASKELL__ == 902+ghc86to810and92failure = assertFailure'+#else+ghc86to810and92failure = assertSuccess #endif