data-diverse-lens 0.5.1.0 → 0.5.2.0

raw patch · 8 files changed

+159/−15 lines, 8 filesdep +generic-lensdep ~data-diversedep ~lensPVP ok

version bump matches the API change (PVP)

Dependencies added: generic-lens

Dependency ranges changed: data-diverse, lens

API changes (from Hackage documentation)

Files

• README.md +3/−0
• data-diverse-lens.cabal +8/−12
• src/Data/Diverse/Lens/Many.hs +47/−2
• src/Data/Diverse/Lens/Which.hs +44/−1
• src/Data/Diverse/Profunctor/Many.hs +2/−0
• src/Data/Diverse/Profunctor/Which.hs +2/−0
• test/Data/Diverse/Lens/ManySpec.hs +30/−0
• test/Data/Diverse/Lens/WhichSpec.hs +23/−0

@@ -8,6 +8,9 @@  # Changelog +* 0.5.2.0+  - Added itemTag and facetTag that also tag/untags the field.+ * 0.5.1.0   - Added faceted, injected, itemized, projected, which is analogous to Profunctor Choice and Strong     but using 'Which' and 'Many'

@@ -1,5 +1,5 @@ name:                data-diverse-lens-version:             0.5.1.0+version:             0.5.2.0 synopsis:            Isos & Lens for Data.Diverse.Many and Prisms for Data.Diverse.Which description:         Isos & Lens for Data.Diverse.Many and Prisms for Data.Diverse.Which                      Refer to [ManySpec.hs](https://github.com/louispan/data-diverse-lens/blob/master/test/Data/Diverse/Lens/ManySpec.hs) and [WhichSpec.hs](https://github.com/louispan/data-diverse-lens/blob/master/test/Data/Diverse/Lens/WhichSpec.hs) for example usages.@@ -13,7 +13,7 @@ build-type:          Simple extra-source-files:  README.md cabal-version:       >=1.10-tested-with:         GHC == 8.0.2, GHC == 8.2.1+tested-with:         GHC == 8.0.1, GHC == 8.2.2  library   hs-source-dirs:      src@@ -24,13 +24,11 @@                        Data.Diverse.Profunctor.Many                        Data.Diverse.Profunctor.Which   build-depends:       base >= 4.7 && < 5-                     , data-diverse >= 1.2.0.3+                     , data-diverse >= 1.3.0.0                      , tagged >= 0.8.5                      , profunctors >= 5.2-  if impl(ghc >= 8.2.0)-    build-depends: lens >= 4.15.2-  else-    build-depends: lens >= 4+                     , generic-lens >= 0.5.0.0+                     , lens >= 4   ghc-options:         -Wall   default-language:    Haskell2010 @@ -41,14 +39,12 @@   other-modules:       Data.Diverse.Lens.ManySpec                        Data.Diverse.Lens.WhichSpec   build-depends:       base-                     , data-diverse >= 1.2.0.1+                     , data-diverse >= 1.3.0.0                      , data-diverse-lens                      , hspec >= 2+                     , lens >= 4                      , tagged >= 0.8.5-  if impl(ghc >= 8.2.0)-    build-depends: lens >= 4.15.2-  else-    build-depends: lens >= 4+                     , generic-lens >= 0.5.0.0   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall   default-language:    Haskell2010 

@@ -1,9 +1,14 @@+{-# OPTIONS_GHC -Wno-orphans #-}+ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}  module Data.Diverse.Lens.Many (       -- * Isomorphism@@ -16,6 +21,8 @@     , item'     , itemL     , itemL'+    , itemTag+    , itemTag'     , itemN     , itemN' @@ -34,6 +41,7 @@ import Data.Diverse.Many import Data.Diverse.TypeLevel import Data.Proxy+import Data.Generics.Product  -- | @_Many = iso fromMany toMany@ _Many :: IsMany t xs a => Iso' (Many xs) (t xs a)@@ -59,6 +67,11 @@ item' :: forall x y xs. UniqueMember x xs => Lens (Many xs) (Many (Replace x y xs)) x y item' = lens fetch (replace' @x @y Proxy) +-- | I'm using "Data.Generics" as the canoical class for HasXXX.+-- Overlap 'HasType' 'typed' with the more efficient 'item'+-- Undecidableinstances! Orphan instance!+instance {-# OVERLAPPING #-} UniqueMember x xs => HasType x (Many xs) where+    typed = item  -- | 'fetchL' ('view' 'itemL') and 'replaceL' ('set' 'itemL') in 'Lens'' form. --@@ -67,7 +80,8 @@ -- x '^.' 'itemL' \@Foo Proxy \`shouldBe` Tagged \@Foo False -- (x '&' 'itemL' \@Foo Proxy '.~' Tagged \@Foo True) \`shouldBe` (5 :: Int) './' Tagged \@Foo True './' Tagged \@Bar \'X' './' 'nil' -- @-itemL :: forall l xs proxy x. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => proxy l -> Lens' (Many xs) x+itemL :: forall l xs proxy x. (UniqueLabelMember l xs, x ~ KindAtLabel l xs)+    => proxy l -> Lens' (Many xs) x itemL p = lens (fetchL p) (replaceL p)  -- | Polymorphic version of 'itemL'@@ -76,10 +90,27 @@ -- let x = (5 :: Int) './' Tagged @Foo False './' Tagged \@Bar \'X' './' 'nil' -- (x '&' itemL' \@Foo Proxy '.~' \"foo") \`shouldBe` (5 :: Int) './' \"foo" './' Tagged \@Bar \'X' './' 'nil' -- @-itemL' :: forall l y xs proxy x. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => proxy l -> Lens (Many xs) (Many (Replace x y xs)) x y+itemL' :: forall l y xs proxy x. (UniqueLabelMember l xs, x ~ KindAtLabel l xs)+    => proxy l -> Lens (Many xs) (Many (Replace x y xs)) x y itemL' p = lens (fetchL p) (replaceL' p) +-- | Variation of 'itemL' that automatically tags and untags the field.+itemTag :: forall l xs proxy x. (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs)+    => proxy l -> Lens' (Many xs) x+itemTag p = lens (fetchTag p) (replaceTag p) +-- | Variation of 'itemL'' that automatically tags and untags the field.+itemTag' :: forall l y xs proxy x. (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs)+    => proxy l -> Lens (Many xs) (Many (Replace (Tagged l x) (Tagged l y) xs)) x y+itemTag' p = lens (fetchTag p) (replaceTag' p)++-- | I'm using "Data.Generics" as the canoical class for HasXXX.+-- Overlap 'HasField' 'field' with the more efficient 'itemN''+-- Undecidableinstances! Orphan instance!+instance {-# OVERLAPPING #-} (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs, ys ~ Replace (Tagged l x) (Tagged l y) xs) =>+  HasField l (Many xs) (Many ys) x y where+    field = itemTag' (Proxy @l)+ -- | 'fetchN' ('view' 'item') and 'replaceN' ('set' 'item') in 'Lens'' form. -- -- @@@ -95,6 +126,13 @@ itemN' ::  forall n y xs proxy x. MemberAt n x xs => proxy n -> Lens (Many xs) (Many (ReplaceIndex n y xs)) x y itemN' p = lens (fetchN p) (replaceN' @n @y p) +-- | I'm using "Data.Generics" as the canoical class for HasXXX.+-- Overlap 'HasPosition' 'position' with the more efficient 'itemN''+-- Undecidableinstances! Orphan instance!+instance {-# OVERLAPPING #-} (MemberAt n x xs, ys ~ ReplaceIndex n y xs) =>+  HasPosition n (Many xs) (Many ys) x y where+    position = itemN' (Proxy @n)+ -----------------------------------------------------------------------  -- | 'select' ('view' 'project') and 'amend' ('set' 'project') in 'Lens'' form.@@ -121,6 +159,13 @@        (Select smaller larger, Amend' smaller smaller' larger)     => Lens (Many larger) (Many (Replaces smaller smaller' larger)) (Many smaller) (Many smaller') project' = lens select (amend' @smaller @smaller' Proxy)++-- | I'm using "Data.Generics" as the canoical class for HasXXX.+-- Overlap 'Subtype' 'super' with the more efficient 'project'+-- Undecidableinstances! Orphan instance!+instance {-# OVERLAPPING #-} (Select smaller larger, Amend smaller larger) =>+  Subtype (Many smaller) (Many larger) where+    super = project  -- | 'selectL' ('view' 'projectL') and 'amendL' ('set' 'projectL') in 'Lens'' form. --

@@ -1,13 +1,21 @@+{-# OPTIONS_GHC -Wno-orphans #-}+ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}  module Data.Diverse.Lens.Which (       -- * Single type       -- ** Prism       facet     , facetL+    , facetTag     , facetN        -- * Multiple types@@ -20,6 +28,9 @@ import Control.Lens import Data.Diverse.Which import Data.Diverse.TypeLevel+import Data.Proxy+import Data.Tagged+import Data.Generics.Sum  ----------------------------------------------------------------- @@ -37,6 +48,14 @@ facet :: forall x xs. (UniqueMember x xs) => Prism' (Which xs) x facet = prism' pick trial' +-- | I'm using "Data.Generics" as the canoical class for AsXXX.+-- Overlap 'AsType' '_Typed' with the more efficient 'facet'+-- Undecidableinstances! Orphan instance!+instance {-# OVERLAPPING #-} UniqueMember x xs => AsType x (Which xs) where+    _Typed = facet+    injectTyped = pick+    projectTyped = trial'+ -- | 'pickL' ('review' 'facetL') and 'trialL'' ('preview' 'facetL'') in 'Prism'' form. -- -- @@@ -44,9 +63,22 @@ --     x = 'preview' ('facetL' \@Bar Proxy) y -- x \`shouldBe` (Just (Tagged 5)) -- @-facetL :: forall l xs proxy x. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => proxy l -> Prism' (Which xs) x+facetL :: forall l xs proxy x. (UniqueLabelMember l xs, x ~ KindAtLabel l xs)+    => proxy l -> Prism' (Which xs) x facetL p = prism' (pickL p) (trialL' p) +-- | Variation of 'fetchL' specialized to 'Tagged' which automatically tags and untags the field.+facetTag :: forall l xs proxy x. (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs)+    => proxy l -> Prism' (Which xs) x+facetTag p = prism' (pickTag p) (trialTag' p)++-- | I'm using "Data.Generics" as the canoical class for AsXXX.+-- Overlap 'AsConstructor' '_Ctor' with the more efficient 'facetTag'+-- Undecidableinstances! Orphan instance!+instance {-# OVERLAPPING #-} (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs)+  => AsConstructor l (Which xs) (Which xs) x x where+    _Ctor = facetTag (Proxy @l)+ -- | 'pickN' ('review' 'facetN') and 'trialN' ('preview' 'facetN') in 'Prism'' form. -- -- @@@ -80,6 +112,17 @@        )     => Prism' (Which tree) (Which branch) inject = prism' diversify reinterpret'++-- | I'm using "Data.Generics" as the canoical class for AsXXX.+-- Overlap 'AsSubtype' '_Sub' with the more efficient 'inject'+-- Undecidableinstances! Orphan instance!+instance {-# OVERLAPPING #-} (Diversify branch tree, Reinterpret' branch tree)+  => AsSubtype (Which branch) (Which tree) where+    _Sub = inject+    injectSub = diversify+    projectSub a = case reinterpret' a of+                       Nothing -> Left a+                       Just a' -> Right a'  -- | 'diversifyL' ('review' 'injectL') and 'reinterpretL'' ('preview' 'injectL') in 'Prism'' form. --

@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}

@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}

@@ -14,6 +14,7 @@ import Data.Tagged import Data.Typeable import Test.Hspec+import Data.Generics.Product  -- `main` is here so that this module can be run from GHCi on its own.  It is -- not needed for automatic spec discovery.@@ -42,6 +43,16 @@             x ^. item @Char `shouldBe` 'X'             x ^. item @(Maybe Char) `shouldBe` Just 'O' +        it "has getter/setter lens using 'Data.Generics.typed" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            x ^. typed @Int `shouldBe` 5+            (x & typed @Int .~ 6) `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            x ^. typed @Bool `shouldBe` False+            (x & typed @Bool .~ True) `shouldBe` (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nil+            x ^. typed @Char `shouldBe` 'X'+            x ^. typed @(Maybe Char) `shouldBe` Just 'O'+            x ^. typed @(Maybe Char) `shouldBe` Just 'O'+         it "has polymorphic getter/setter lens using 'item''" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil             (x & item' @(Maybe Char) .~ Just 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nil@@ -59,6 +70,10 @@             let x = (5 :: Int) ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ nil             (x & itemL' @Foo Proxy .~ "foo") `shouldBe` (5 :: Int) ./ "foo" ./ Tagged @Bar 'X' ./ nil +        it "has polymorphic getter/setter lens using 'Data.Generics.Product.Fields.field'" $ do+            let x = (5 :: Int) ./ Tagged @"foo" False ./ Tagged @"bar" 'X' ./ nil+            (x & field @"foo" .~ "foodata") `shouldBe` (5 :: Int) ./ Tagged @"foo" "foodata" ./ Tagged @"bar" 'X' ./ nil+         it "has getter/setter lens for duplicate fields using 'itemN'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             x ^. itemN (Proxy @0) `shouldBe` 5@@ -83,10 +98,25 @@             (x & itemN' (Proxy @4) .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ "Foo" ./ Just 'A' ./ nil             (x & itemN' (Proxy @5) .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ "Foo" ./ nil +        it "has polymorphic getter/setter lens for duplicate fields using 'Data.Generic.Product.Positions.position'" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & position @0 .~ "Foo") `shouldBe` "Foo" ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & position @1 .~ "Foo") `shouldBe` (5 :: Int) ./ "Foo" ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & position @2 .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ "Foo" ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & position @3 .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ "Foo" ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & position @4 .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ "Foo" ./ Just 'A' ./ nil+            (x & position @5 .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ "Foo" ./ nil+         it "has getter/setter lens for multiple fields using 'project'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil             x ^. (project @'[Int, Maybe Char]) `shouldBe` (5 :: Int) ./ Just 'O' ./ nil             (x & (project @'[Int, Maybe Char]) .~ ((6 :: Int) ./ Just 'P' ./ nil)) `shouldBe`+                (6 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nil++        it "has getter/setter lens for multiple fields using 'Data.Generics.Product.Subtype.super'" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            x ^. (super @(Many '[Int, Maybe Char])) `shouldBe` (5 :: Int) ./ Just 'O' ./ nil+            (x & (super @(Many '[Int, Maybe Char])) .~ ((6 :: Int) ./ Just 'P' ./ nil)) `shouldBe`                 (6 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nil          it "has polymorphic getter/setter lens for multiple fields using 'project'" $ do

@@ -11,6 +11,7 @@ import Control.Lens import Data.Diverse import Data.Diverse.Lens+import Data.Generics.Sum import Data.Proxy import Data.Tagged import Test.Hspec@@ -38,11 +39,26 @@                 x = preview (facet @Int) y             x `shouldBe` (Just 5) +        it "can be constructed and destructed by type with 'Data.Generics.Sum.Typed._Typed'" $ do+            let y = review (_Typed @Int) (5 :: Int) :: Which '[Bool, Int, Char, Bool, Char]+                x = preview (_Typed @Int) y+            x `shouldBe` (Just 5)+         it "can be constructed and destructed by label with 'facetL'" $ do             let y = review (facetL @Bar Proxy) (Tagged (5 :: Int)) :: Which '[Tagged Foo Bool, Tagged Bar Int, Char, Bool, Char]                 x = preview (facetL @Bar Proxy) y             x `shouldBe` (Just (Tagged 5)) +        it "can be constructed and destructed by label with 'facetTag'" $ do+            let y = review (facetTag @Bar Proxy) (5 :: Int) :: Which '[Tagged Foo Bool, Tagged Bar Int, Char, Bool, Char]+                x = preview (facetTag @Bar Proxy) y+            x `shouldBe` (Just 5)++        it "can be constructed and destructed by label with 'Data.Generics.Sum.Constructors._Ctor'" $ do+            let y = review (_Ctor @"Bar") (5 :: Int) :: Which '[Tagged "Foo" Bool, Tagged "Bar" Int, Char, Bool, Char]+                x = preview (_Ctor @"Bar") y+            x `shouldBe` (Just 5)+         it "can be constructed and destructed by index with 'facetN'" $ do             let y = review (facetN (Proxy @4)) (5 :: Int) :: Which '[Bool, Int, Char, Bool, Int, Char]                 x = preview (facetN (Proxy @4)) y@@ -53,6 +69,13 @@                 y = review (inject @_ @[Bool, Int, Char, String]) x             y `shouldBe` pick (5 :: Int)             let y' = preview (inject @[String, Int]) y+            y' `shouldBe` Just (pick (5 :: Int))++        it "can be 'diversify'ed and 'reinterpreted' by type with 'Data.Generics.Sum.Subtype._Sub'" $ do+            let x = pick (5 :: Int) :: Which '[String, Int]+                y = review (_Sub @_ @(Which [Bool, Int, Char, String])) x+            y `shouldBe` pick (5 :: Int)+            let y' = preview (_Sub @(Which [String, Int])) y             y' `shouldBe` Just (pick (5 :: Int))          it "can be 'diversifyL'ed and 'reinterpretedL' by label with 'injectL'" $ do