prolens 0.0.0.0 → 0.0.0.1

raw patch · 6 files changed

+171/−53 lines, 6 filesdep ~basedep ~doctestPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, doctest

API changes (from Hackage documentation)

Files

• CHANGELOG.md +16/−0
• prolens.cabal +6/−5
• src/Prolens.hs +76/−17
• test/Test/Data.hs +5/−1
• test/Test/Prolens/Inspection.hs +2/−2
• test/Test/Prolens/Property.hs +66/−28

@@ -3,6 +3,22 @@ `prolens` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 👩‍👧 0.0.0.1 — Mar 14, 2021++* [#51](https://github.com/kowainik/prolens/issues/51):+  Support GHC 9.0. Upgrade minor versions support to 8.10.4.+* [#28](https://github.com/kowainik/prolens/issues/28):+  Inspection tests for prisms, ensuring optimal performance.+* [#46](https://github.com/kowainik/prolens/issues/46):+  Document typeclasses laws.+* [#7](https://github.com/kowainik/prolens/issues/7):+  Add typeclasses laws tests for the following types:++    + `Profunctor` laws for `Forget`+    + `Monoidal` laws for `(->)`++Thanks @CristhianMotoche, @xplosunn for helping with this release!+ ## 0.0.0.0  * Initially created.

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                prolens-version:             0.0.0.0+version:             0.0.0.1 synopsis:            Profunctor-based lightweight implementation of optics description:     Lightweight and performance implementation of optics — lenses, prisms, traversals.@@ -14,21 +14,22 @@ license-file:        LICENSE author:              Veronika Romashkina, Dmitrii Kovanikov maintainer:          Kowainik <xrom.xkov@gmail.com>-copyright:           2020 Kowainik+copyright:           2020-2021 Kowainik category:            Data, Optics, Lenses build-type:          Simple extra-doc-files:     README.md                      CHANGELOG.md tested-with:         GHC == 8.6.5                      GHC == 8.8.4-                     GHC == 8.10.2+                     GHC == 8.10.4+                     GHC == 9.0.1  source-repository head   type:                git   location:            https://github.com/kowainik/prolens.git  common common-options-  build-depends:       base >= 4.12.0.0 && < 4.15+  build-depends:       base >= 4.12.0.0 && < 4.16    ghc-options:         -Wall                        -Wcompat@@ -96,4 +97,4 @@   import:              common-test   type:                exitcode-stdio-1.0   main-is:             Doctest.hs-  build-depends:       doctest ^>= 0.17+  build-depends:       doctest >= 0.16.3 && < 0.19

@@ -5,9 +5,12 @@ {-# LANGUAGE TypeFamilies          #-}  {- |-Copyright: (c) 2020 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>+Module                  : Prolens+Copyright               : (c) 2020-2021 Kowainik+SPDX-License-Identifier : MPL-2.0+Maintainer              : Kowainik <xrom.xkov@gmail.com>+Stability               : Stable+Portability             : Portable  The @prolens@ package is a Haskell library with a minimal and lightweight implementation of optics based on 'Profunctor's. __'Optic'__ is a high-level@@ -148,6 +151,7 @@ import Data.Coerce (coerce) import Data.Monoid (First (..)) + -- $setup -- >>> import Data.Function ((&)) @@ -194,7 +198,7 @@ Instances of 'Profunctor' should satisfy the following laws:  * __Identity:__ @'dimap' 'id' 'id' ≡ 'id'@-* __Composition:__ @'dimap' (inAB . inBC) (outYZ . outXY) ≡ 'dimap' outBC outYZ . 'dimap' outAB outXY@+* __Composition:__ @'dimap' (inAB . inBC) (outYZ . outXY) ≡ 'dimap' inBC outYZ . 'dimap' inAB outXY@  @since 0.0.0.0 -}@@ -239,6 +243,20 @@ type, and you can decide what type it should be. This is convenient for implementing various functions. E.g. 'lens' uses this fact. +Instances of 'Strong' should satisfy the following laws:++* __'first' via 'second' swap:__ @'first' ≡ 'dimap' 'Data.Tuple.swap' 'Data.Tuple.swap' . 'second'@+* __'second' via 'first' swap:__ @'second' ≡ 'dimap' 'Data.Tuple.swap' 'Data.Tuple.swap' . 'first'@++* __Fst functor:__ @'dimap' 'fst' 'id' ≡ 'fmap' 'fst' . 'first'@+* __Snd functor:__ @'dimap' 'snd' 'id' ≡ 'fmap' 'snd' . 'second'@++* __Distribution over 'first':__ @'dimap' ('second' f) 'id' . 'first' ≡ 'fmap' ('second' f) . 'first'@+* __Distribution over 'second':__ @'dimap' ('first' f) 'id' . 'second' ≡ 'fmap' ('first' f) . 'second'@++* __Associativity of 'first':__ @'first' . 'first' ≡ 'dimap' (\\((a, b), c) -> (a, (b, c))) (\\(a, (b, c)) -> ((a, b), c)) . 'first'@+* __Associativity of 'second':__ @'second' . 'second' ≡ 'dimap' (\\(a, (b, c)) -> ((a, b), c)) (\\((a, b), c) -> (a, (b, c))) . 'second'@+ @since 0.0.0.0 -} class Profunctor p => Strong p where@@ -272,6 +290,29 @@ type, and you can decide what type it should be. This is convenient for implementing various functions. E.g. 'prism' uses this fact. ++Assuming, we have the following functions in scope:++@+swapEither  :: Either a b -> Either b a+unnestLeft  :: Either (Either a b) c -> Either a (Either b c)+unnestRight :: Either a (Either b c) -> Either (Either a b) c+@++Instances of 'Choice' should satisfy the following laws:++* __'left' via 'right' swap:__ @'left' ≡ 'dimap' swapEither swapEither . 'right'@+* __'right' via 'left' swap:__ @'right' ≡ 'dimap' swapEither swapEither . 'left'@++* __'Left' functor:__ @'fmap' 'Left' ≡ 'dimap' 'Left' 'id' . 'left'@+* __'Right' functor:__ @'fmap' 'Right' ≡ 'dimap' 'Right' 'id' . 'right'@++* __Distribution over 'left':__ @'dimap' ('right' f) 'id' . 'left' ≡ 'fmap' ('right' f) . 'left'@+* __Distribution over 'right':__ @'dimap' ('left' f) 'id' . 'right' ≡ 'fmap' ('left' f) . 'right'@++* __Associativity of 'left':__ @'left' . 'left' ≡ 'dimap' unnestLeft unnestRight . 'left'@+* __Associativity of 'right':__ @'right' . 'right' ≡ 'dimap' unnestRight unnestLeft . 'right'@+ @since 0.0.0.0 -} class Profunctor p => Choice p where@@ -309,11 +350,27 @@ {- | 'Monoidal' is 'Strong' 'Profunctor' that can be appended. It is similar to 'Monoid's but for higher-kinded types. +Instances of 'Monoidal' should satisfy the following laws:++* __Right identity:__ @'pappend' f 'pempty' ≡ 'first' f@+* __Left identity:__ @'pappend' 'pempty' f ≡ 'second' f@+* __Associativity:__ @'pappend' f ('pappend' g h) ⋍ 'pappend' ('pappend' f g) h@++⚠️ __Note:__ The @⋍@ operator in the __associativity__ law is equality+ignoring the structure. The law is written in that way because+'pappend' returns a tuple and the order of nested tuples depends on+the order of 'pappend' applications. In practice, this means, that if+you want to check the law, you reorder tuples in the following way:++@+'pappend' f ('pappend' g h) ≡ 'dimap' (\\(a, (b, c)) -> ((a, b), c)) (\\((a, b), c) -> (a, (b, c))) ('pappend' ('pappend' f g) h)+@+ @since 0.0.0.0 -} class Strong p => Monoidal p where     pappend :: p a b -> p c d -> p (a, c) (b, d)-    pempty :: p a a+    pempty  :: p a a  -- | @since 0.0.0.0 instance Monoidal (->) where@@ -574,7 +631,7 @@ -} infixr 4 .~ (.~) :: Lens' source a -> a -> source -> source-(.~) = set+(.~) l = set l {-# INLINE (.~) #-}  {- | The operator form of 'over'.@@ -583,7 +640,7 @@ -} infixr 4 %~ (%~) :: Lens' source a -> (a -> a) -> source -> source-(%~) = over+(%~) l = over l {-# INLINE (%~) #-}  {- | 'Lens'' for a tuple on the first argument.@@ -750,13 +807,14 @@ @since 0.0.0.0 -} newtype Forget r a b = Forget-    { unForget :: a -> r+    { unForget :: a -> Maybe r     }  -- | @since 0.0.0.0 instance Functor (Forget r x) where     fmap :: (a -> b) -> Forget r x a -> Forget r x b     fmap _ = coerce+    {-# INLINE fmap #-}  -- | @since 0.0.0.0 instance Profunctor (Forget r) where@@ -775,23 +833,24 @@     {-# INLINE second #-}  -- | @since 0.0.0.0-instance Monoid r => Choice (Forget r) where+instance Choice (Forget r) where     left :: Forget r a b -> Forget r (Either a c) (Either b c)-    left (Forget ar) = Forget (either ar (const mempty))+    left (Forget ar) = Forget (either ar (const Nothing))     {-# INLINE left #-}      right :: Forget r a b -> Forget r (Either c a) (Either c b)-    right (Forget ar) = Forget (either (const mempty) ar)+    right (Forget ar) = Forget (either (const Nothing) ar)     {-# INLINE right #-}  -- | @since 0.0.0.0-instance (Monoid r) => Monoidal (Forget r) where+instance Monoidal (Forget r) where     pappend :: Forget r a b -> Forget r c d -> Forget r (a, c) (b, d)-    pappend (Forget ar) (Forget cr) = Forget (\(a, c) -> ar a <> cr c)+    pappend (Forget ar) (Forget cr) = Forget+        (\(a, c) -> getFirst $  First (ar a) <> First (cr c))     {-# INLINE pappend #-}      pempty :: Forget r a a-    pempty = Forget (const mempty)+    pempty = Forget (const Nothing)     {-# INLINE pempty #-}  {- | Match a value from @source@ type.@@ -800,14 +859,14 @@ -} preview     :: forall a source p-    .  (p ~ Forget (First a))+    .  (p ~ Forget a)     => Optic p source source a a  -- ^ 'Optic' that can be prism     -> source  -- ^ Object (possible sum type)     -> Maybe a  -- ^ Value of type @a@ from a specific constructor preview paapss = coerce (paapss wrap)   where-    wrap :: Forget (First a) a a-    wrap = coerce @(a -> Maybe a) @(Forget (First a) a a) Just+    wrap :: Forget a a a+    wrap = coerce @(a -> Maybe a) @(Forget a a a) Just     {-# INLINE wrap #-} {-# INLINE preview #-} -- preview paapss = getFirst . unForget (paapss (Forget (First . Just)))

@@ -19,6 +19,7 @@       -- * Generators     , genFun     , genFunction+    , genForget     , genHaskeller     , genInt     , genKnowledge@@ -27,7 +28,7 @@  import Test.Hspec.Hedgehog (MonadGen) -import Prolens (Fun (..), Lens', Prism', lens, prism')+import Prolens (Forget (..), Fun (..), Lens', Prism', lens, prism')  import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range@@ -129,3 +130,6 @@     , const Nothing     , Just . f     ]++genForget :: MonadGen m => m (Forget Int Int a)+genForget = Forget . unFun <$> genFun

@@ -9,7 +9,7 @@     ( inspectionSpecs     ) where -import Test.Hspec (Spec, describe, it, shouldSatisfy, xit)+import Test.Hspec (Spec, describe, it, shouldSatisfy) import Test.Inspection (Result (..), hasNoTypeClasses, inspectTest, (===))  import Prolens (preview, set, view)@@ -77,7 +77,7 @@ prismSpecs :: Spec prismSpecs = describe "Prism" $ do     describe "preview" $ do-        xit "preview _Ctor x ≡ case (Ctor _) of" $+        it "preview _Ctor x ≡ case (Ctor _) of" $             $(inspectTest $ 'matchMarkPrism === 'matchMarkManual) `shouldSatisfy` isSuccess  -- Helper functions

@@ -3,11 +3,12 @@     , typeclassesPropertySpecs     ) where +import Hedgehog (Gen) import Test.Hspec (Spec, describe, it) import Test.Hspec.Hedgehog (PropertyT, forAll, forAllWith, hedgehog, (===))  import Prolens-import Test.Data (genFun, genFunction, genHaskeller, genInt, genName, nameL)+import Test.Data (genFun, genFunction, genForget, genHaskeller, genInt, genName, nameL)   lensPropertySpecs :: Spec@@ -26,43 +27,80 @@         set nameL valueNew (set nameL value source) === set nameL valueNew source  typeclassesPropertySpecs :: Spec-typeclassesPropertySpecs = describe "Class Laws" -- $ do+typeclassesPropertySpecs = describe "Class Laws" $ do     profunctorsSpec+    monoidalSpec  profunctorsSpec :: Spec profunctorsSpec = describe "Profunctor" $ do-    describe "(->)" $ do-        it "Identity: dimap id id ≡ id" $ hedgehog $ do-            f <- forAllWith (const "f") genFunction-            x <- forAll genInt-            dimap id id f x === f x-        it "Composition: dimap (ab . bc) (yz . xy) ≡ dimap bc yz . dimap ab xy" $ hedgehog $ do+    profunctorLaws "(->)" genFunction eqFunction+    profunctorLaws "Fun" genFun eqFun+    profunctorLaws "Forget" genForget eqForget -            f  <- forAllWith (const "f")  genFunction-            ab <- forAllWith (const "ab") genFunction-            bc <- forAllWith (const "bc") genFunction-            xy <- forAllWith (const "xy") genFunction-            yz <- forAllWith (const "xy") genFunction -            n <- forAll genInt-            dimap (ab . bc) (yz . xy) f n === (dimap bc yz . dimap ab xy) f n-    describe "Fun" $ do-        it "Identity: dimap id id ≡ id" $ hedgehog $ do-            f <- forAllWith (const "f") genFun-            eqFun (dimap id id f) f-        it "Composition: dimap (ab . bc) (yz . xy) ≡ dimap bc yz . dimap ab xy" $ hedgehog $ do+profunctorLaws+  :: Profunctor p+  => String+  -> Gen (p Int Int)+  -> (p Int Int -> p Int Int -> PropertyT IO ())+  -> Spec+profunctorLaws name genProfunctor cmp =+  describe name $ do+    it "Identity: dimap id id ≡ id" $ hedgehog $ do+        f <- forAllWith (const "f") genProfunctor+        dimap id id f `cmp` f -            f  <- forAllWith (const "f")  genFun-            ab <- forAllWith (const "ab") genFunction-            bc <- forAllWith (const "bc") genFunction-            xy <- forAllWith (const "xy") genFunction-            yz <- forAllWith (const "xy") genFunction+    it "Composition: dimap (ab . bc) (yz . xy) ≡ dimap bc yz . dimap ab xy" $ hedgehog $ do+        f  <- forAllWith (const "f")  genProfunctor+        ab <- forAllWith (const "ab") genFunction+        bc <- forAllWith (const "bc") genFunction+        xy <- forAllWith (const "xy") genFunction+        yz <- forAllWith (const "xy") genFunction -            eqFun-                (dimap (ab . bc) (yz . xy) f)-                (dimap bc yz $ dimap ab xy f)+        dimap (ab . bc) (yz . xy) f `cmp` (dimap bc yz . dimap ab xy) f ++eqFunction :: (Int -> Int) -> (Int -> Int) -> PropertyT IO ()+eqFunction f g = do+    n <- forAll genInt+    f n === g n+ eqFun :: Fun Maybe Int Int -> Fun Maybe Int Int -> PropertyT IO () eqFun fun1 fun2 = do     x <- forAll genInt     unFun fun1 x === unFun fun2 x++eqForget :: Forget Int Int a -> Forget Int Int a -> PropertyT IO ()+eqForget forget1 forget2 = do+    x <- forAll genInt+    unForget forget1 x === unForget forget2 x+    +monoidalSpec :: Spec+monoidalSpec = describe "Monoidal" $ do+    describe "(->)" $ do+        it "Identity: pappend f pempty ≡ first f" $ hedgehog $ do+            f <- forAllWith (const "f") genFunction+            x <- forAll genInt+            y <- forAll genInt+            pappend f pempty (x, y) === first f (x, y)+        it "Identity: pappend pempty f ≡ second f" $ hedgehog $ do+            f <- forAllWith (const "f") genFunction+            x <- forAll genInt+            y <- forAll genInt+            pappend pempty f (x, y) === second f (x, y)+        it "Associativity (right)" $ hedgehog $ do+            f <- forAllWith (const "f") genFunction+            g <- forAllWith (const "g") genFunction+            h <- forAllWith (const "h") genFunction+            x <- forAll genInt+            y <- forAll genInt+            z <- forAll genInt+            pappend f (pappend g h) (x, (y, z)) === (f x, (g y, h z))+        it "Associativity (left)" $ hedgehog $ do+            f <- forAllWith (const "f") genFunction+            g <- forAllWith (const "g") genFunction+            h <- forAllWith (const "h") genFunction+            x <- forAll genInt+            y <- forAll genInt+            z <- forAll genInt+            pappend (pappend f g) h ((x, y), z) === ((f x, g y), h z)