summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorlouispan <>2018-05-04 12:36:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-05-04 12:36:00 (GMT)
commitc213f88942beee41a77988451f59e16f0a8fb521 (patch)
tree53e020f8783a9a2b9dee51a06135064e1c1fe8b4
parent1b4486518efacb65d8649f776e25fb91197b3467 (diff)
version 3.1.1.03.1.1.0
-rw-r--r--README.md3
-rw-r--r--data-diverse-lens.cabal6
-rw-r--r--src/Data/Diverse/Lens/Many.hs27
-rw-r--r--src/Data/Diverse/Lens/Which.hs42
-rw-r--r--test/Data/Diverse/Lens/WhichSpec.hs8
5 files changed, 31 insertions, 55 deletions
diff --git a/README.md b/README.md
index d0f2cc3..c3ffbfe 100644
--- a/README.md
+++ b/README.md
@@ -7,6 +7,9 @@ Refer to [ManySpec.hs](https://github.com/louispan/data-diverse-lens/blob/master
# Changelog
+* 3.1.1.0
+ - `itemTag` only requires `Has` and likewise `facetTag` only requires `AsFacet`.
+
* 3.1.0.0
- Replaced `HasItem` with `Data.Has`.
diff --git a/data-diverse-lens.cabal b/data-diverse-lens.cabal
index 4292938..362732d 100644
--- a/data-diverse-lens.cabal
+++ b/data-diverse-lens.cabal
@@ -1,5 +1,5 @@
name: data-diverse-lens
-version: 3.1.0.0
+version: 3.1.1.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.
@@ -24,7 +24,7 @@ library
Data.Diverse.Profunctor.Many
Data.Diverse.Profunctor.Which
build-depends: base >= 4.7 && < 5
- , data-diverse >= 3.0.0.0
+ , data-diverse >= 3.1.0.0
, tagged >= 0.8.5
, profunctors >= 5.2
, generic-lens >= 0.5.0.0
@@ -40,7 +40,7 @@ test-suite data-diverse-lens-test
other-modules: Data.Diverse.Lens.ManySpec
Data.Diverse.Lens.WhichSpec
build-depends: base
- , data-diverse >= 3.0.0.0
+ , data-diverse >= 3.1.0.0
, data-diverse-lens
, hspec >= 2
, lens >= 4
diff --git a/src/Data/Diverse/Lens/Many.hs b/src/Data/Diverse/Lens/Many.hs
index 1846866..cdba111 100644
--- a/src/Data/Diverse/Lens/Many.hs
+++ b/src/Data/Diverse/Lens/Many.hs
@@ -25,11 +25,11 @@ module Data.Diverse.Lens.Many (
-- ** Lens for a single field
, Has(..)
, item'
+ , itemTag
+ , itemTag'
, Had(..)
, HasL(..)
, HadL(..)
- , HasTag(..)
- , HadTag(..)
-- , genericItemTag
, HasN(..)
, HadN(..)
@@ -91,6 +91,13 @@ instance (UniqueMember x xs) => Had x (Many xs) where
type Replaced x b (Many xs) = Many (Replace x b xs)
item = lens grab (replace @x)
+itemTag' :: forall l a s. Has (Tagged l a) s => Lens' s a
+itemTag' = item' @(Tagged l a) . iso unTagged Tagged
+
+itemTag :: forall l a b s. Had (Tagged l a) s
+ => Lens s (Replaced (Tagged l a) (Tagged l b) s) a b
+itemTag = item @(Tagged l a) . iso unTagged (Tagged @l)
+
-- | 'grabL' ('view' 'itemL') and 'replaceL' ('set' 'itemL') in 'Lens'' form.
--
-- @
@@ -127,22 +134,6 @@ instance (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => HadL l x (Many xs) wh
type ReplacedL l x b (Many xs) = Many (Replace (KindAtLabel l xs) b xs)
itemL = lens (grabL @l) (replaceL @l)
--- | Variation of 'itemL'' that automatically tags and untags a Tagged field.
--- @
-class HasL l (Tagged l a) s => HasTag (l :: k) a s where
- itemTag' :: Lens' s a
-
-instance HasL l (Tagged l a) s => HasTag (l :: k) a s where
- itemTag' = itemL' @l . iso unTagged Tagged
-
--- | Polymorphic version of 'itemTag''
--- @
-class HadL l (Tagged l a) s => HadTag (l :: k) a s where
- itemTag :: Lens s (ReplacedL l (Tagged l a) (Tagged l b) s) a b
-
-instance HadL l (Tagged l a) s => HadTag (l :: k) a s where
- itemTag = itemL @l . iso unTagged (Tagged @l)
-
-- | 'grabN' ('view' 'item') and 'replaceN'' ('set' 'item'') in 'Lens'' form.
--
-- @
diff --git a/src/Data/Diverse/Lens/Which.hs b/src/Data/Diverse/Lens/Which.hs
index 0fc1535..dd4c658 100644
--- a/src/Data/Diverse/Lens/Which.hs
+++ b/src/Data/Diverse/Lens/Which.hs
@@ -18,11 +18,10 @@ module Data.Diverse.Lens.Which (
-- ** Prism
AsFacet(..)
, MatchingFacet(..)
+ , facetTag
+ , matchingFacetTag
, AsFacetL(..)
, MatchingFacetL(..)
- , AsFacetTag(..)
- , MatchingFacetTag(..)
- -- , genericFacetTag
, AsFacetN(..)
, MatchingFacetN(..)
@@ -98,6 +97,16 @@ class AsFacet a s => MatchingFacet a s t | s a -> t where
instance (UniqueMember x xs, ys ~ Remove x xs) => MatchingFacet x (Which xs) (Which ys) where
matchingFacet = trial
+-- | Variation of 'facet' specialized to 'Tagged' which automatically tags and untags the field.
+-- A default implementation using generics is not provided as it make GHC think that @l@ must be type @Symbol@
+-- when @l@ can actually be any kind.
+facetTag :: forall l a s. (AsFacet (Tagged l a) s) => Prism' s a
+facetTag = facet @(Tagged l a) . iso unTagged (Tagged @l)
+
+-- | Untagged version of 'MatchingFacet'
+matchingFacetTag :: forall l a s t. MatchingFacet (Tagged l a) s t => s -> Either t a
+matchingFacetTag = fmap unTagged . matchingFacet @(Tagged l a)
+
-- | 'pickL' ('review' 'facetL') and 'trialL'' ('preview' 'facetL'') in 'Prism'' form.
--
-- @
@@ -119,33 +128,6 @@ instance (UniqueLabelMember l xs, x ~ KindAtLabel l xs, ys ~ Remove x xs)
=> MatchingFacetL l x (Which xs) (Which ys) where
matchingFacetL = trialL @l
--- | Variation of 'grabL' specialized to 'Tagged' which automatically tags and untags the field.
--- A default implementation using generics is not provided as it make GHC think that @l@ must be type @Symbol@
--- when @l@ can actually be any kind.
--- Create instances of 'AsFacetTag'' using "Data.Generics.Sum.Constructors" as follows:
--- @
--- instance AsConstructor' l Foo Foo a a => AsFacetTag l a Foo where
--- facetTag = _Ctor @l
--- @
-class AsFacetTag (l :: k) a s | s l -> a where
- facetTag :: Prism' s a
-
--- -- | Make it easy to create an instance of 'AsFacetTag' using 'Data.Generics.Sum.Constructors'
--- -- NB. This is not a default signature for AsFacetTag, as this makes GHC think that l must be type 'Symbol', when actually @l@ can be any kind @k@
--- genericFacetTag :: forall l a s proxy. (AsConstructor l s s a a) => Prism' s a
--- genericFacetTag = _Ctor @l
-
-instance (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs) => AsFacetTag l x (Which xs) where
- facetTag = prism' (pickTag @l) (trialTag' @l)
-
--- | Untagged version of 'MatchingFacet'
-class AsFacetTag l a s => MatchingFacetTag l a s t | l s a -> t where
- matchingFacetTag :: s -> Either t a
-
-instance (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs, ys ~ Remove (Tagged l x) xs)
- => MatchingFacetTag l x (Which xs) (Which ys) where
- matchingFacetTag = trialTag @l
-
-- | 'pickN' ('review' 'facetN') and 'trialN' ('preview' 'facetN') in 'Prism'' form.
--
-- @
diff --git a/test/Data/Diverse/Lens/WhichSpec.hs b/test/Data/Diverse/Lens/WhichSpec.hs
index 8246467..0a4216b 100644
--- a/test/Data/Diverse/Lens/WhichSpec.hs
+++ b/test/Data/Diverse/Lens/WhichSpec.hs
@@ -2,10 +2,10 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE RankNTypes #-}
module Data.Diverse.Lens.WhichSpec (main, spec) where
@@ -52,11 +52,11 @@ spec = do
x `shouldBe` Just (Tagged 5)
z `shouldBe` Nothing
- it "can be constructed and destructed by label with 'facetTag'" $ do
+ it "can be constructed and destructed by label with 'facetTag" $ do
let y = review (facetTag @Bar) (5 :: Int) :: Which '[Tagged Foo Bool, Tagged Bar Int, Char, Bool, Char]
x = preview (facetTag @Bar) y
- z = preview (facetTag @Foo) y
- x `shouldBe` Just 5
+ z = preview (facetTag @Foo @Bool) y
+ x `shouldBe` Just (5 :: Int)
z `shouldBe` Nothing
it "can be constructed and destructed by index with 'facetN'" $ do