Permalink
Browse files

Updated Lens instances for Lens 4.0.

  • Loading branch information...
1 parent 6086c54 commit 3da9e7da71516b34acbbf25ea9fe004f3cb21301 @bovinespirit committed Feb 3, 2014
Showing with 28 additions and 47 deletions.
  1. +15 −19 Data/EnumMapMap/Base.hs
  2. +4 −5 Data/EnumMapSet/Base.hs
  3. +2 −0 changelog
  4. +6 −6 enummapmap.cabal
  5. +0 −5 test/UnitBoth.hs
  6. +1 −12 test/UnitEnumMapMap.hs
View
@@ -85,18 +85,17 @@ import Control.DeepSeq (NFData(rnf))
import Data.Bits
import Data.Default
import qualified Data.Foldable as Fold
-import Control.Lens.At (At, Contains, IxValue,
- at, contains, containsLookup)
-import Control.Lens.Combinators ((<&>))
-import Control.Lens.Each (Index, Each, each)
+import Control.Lens.At (At, Index, Ixed, IxValue,
+ at, ix)
+import Control.Lens.Lens ((<&>))
+import Control.Lens.Each (Each)
import qualified Control.Lens.Fold as Lens
-import Control.Lens.Getter (Contravariant)
import qualified Control.Lens.Indexed as Lens
import qualified Control.Lens.Setter as Lens
import Data.Maybe (fromMaybe)
import Data.SafeCopy
import Data.Semigroup
-import Data.Traversable (Traversable(traverse), sequenceA)
+import Data.Traversable (Traversable(traverse))
import Data.Typeable
import GHC.Exts (Word(..), Int(..),
uncheckedShiftRL#, uncheckedShiftL#)
@@ -886,28 +885,25 @@ instance (SafeCopy k, SafeCopy (NestedPair k v), IsKey k,
type instance Index (EnumMapMap k v) = k
-instance (Applicative f,
- Fold.Foldable (EnumMapMap k),
- IsKey (Index (EnumMapMap k a)),
- IsKey (Index (EnumMapMap k b))) =>
- Each f (EnumMapMap k a) (EnumMapMap k b) a b where
- each f m = sequenceA $ mapWithKey f' m
- where f' = Lens.indexed f
-
-instance (Contravariant f, Functor f, IsKey k, SubKey k k v) =>
- Contains f (EnumMapMap k v) where
- contains = containsLookup lookup
- {-# INLINE contains #-}
+instance (Fold.Foldable (EnumMapMap k), IsKey k, SubKey k k a, SubKey k k b) =>
+ Each (EnumMapMap k a) (EnumMapMap k b) a b
type instance IxValue (EnumMapMap k v) = Result k k v
+instance (IsKey k, SubKey k k v) =>
+ Ixed (EnumMapMap k v) where
+ ix k f m = case lookup k m of
+ Just v -> f v <&> \v' -> insert k v' m
+ Nothing -> pure m
+ {-# INLINE ix #-}
instance (IsKey k, SubKey k k v) =>
At (EnumMapMap k v) where
- at k f m = Lens.indexed f k mv <&>
+ at k f m = f mv <&>
\r -> case r of
Nothing -> maybe m (const (delete k m)) mv
Just v' -> insert k v' m
where mv = lookup k m
+ {-# INLINE at #-}
instance (IsKey k, Fold.Foldable (EnumMapMap k)) =>
Lens.FunctorWithIndex k (EnumMapMap k) where
View
@@ -74,8 +74,7 @@ import Prelude hiding (lookup, map, filter, foldr, foldl,
null, init, head, tail, all)
import Control.Lens.At (Contains, contains)
-import Control.Lens.Combinators ((<&>))
-import qualified Control.Lens.Indexed as Lens
+import Control.Lens.Lens ((<&>))
import Data.Bits
import qualified Data.List as List
import Data.Maybe (fromMaybe)
@@ -531,9 +530,9 @@ instance (SafeCopy (S k), EMM.IsKey (S k),
-- Lens
-instance (Functor f, EMM.IsKey k, EMM.SubKey k k (), EMM.Result k k () ~ ()) =>
- Contains f (EnumMapSet k) where
- contains k f s = Lens.indexed f k (member k s) <&> \b ->
+instance (EMM.IsKey k, EMM.SubKey k k (), EMM.Result k k () ~ ()) =>
+ Contains (EnumMapSet k) where
+ contains k f s = f (member k s) <&> \b ->
if b then insert k s else delete k s
{-# INLINE contains #-}
View
@@ -1,4 +1,6 @@
+0.8.0 - Update for Lens 4.0
+
0.7.0 - Add some Lenses, and a dependency on the Lens package.
0.6.0 - Add Traversable, Typeable and SafeCopy instances, adding a dependency on the safecopy package.
View
@@ -28,7 +28,7 @@ Library
data-default,
deepseq >= 1.2 && < 1.4,
ghc-prim,
- lens >= 3.10 && < 4,
+ lens >= 4 && < 5,
safecopy >= 0.8 && < 0.9,
semigroups >= 0.8
ghc-options: -Wall -O2
@@ -47,7 +47,7 @@ Test-Suite test-enummapmap-lazy
hspec-expectations,
cereal >= 0.4,
deepseq >= 1.2 && < 1.4,
- lens >= 3.10 && < 4,
+ lens >= 4 && < 5,
safecopy >= 0.8 && < 0.9,
semigroups >= 0.8,
enummapmap
@@ -82,7 +82,7 @@ Test-Suite test-enummapmap-strict
hspec-expectations,
cereal >= 0.4,
deepseq >= 1.2 && < 1.4,
- lens >= 3.10 && < 4,
+ lens >= 4 && < 5,
safecopy >= 0.8 && < 0.9,
semigroups >= 0.8,
enummapmap
@@ -117,7 +117,7 @@ Test-Suite test-enummapset
hspec-expectations,
cereal >= 0.4,
deepseq >= 1.2 && < 1.4,
- lens >= 3.10 && < 4,
+ lens >= 4 && < 5,
safecopy >= 0.8 && < 0.9,
containers >= 0.4.2,
enummapmap
@@ -152,7 +152,7 @@ Test-Suite test-both-lazy
cereal >= 0.4,
deepseq >= 1.2 && < 1.4,
- lens >= 3.10 && < 4,
+ lens >= 4 && < 5,
safecopy >= 0.8 && < 0.9,
enummapmap
@@ -172,7 +172,7 @@ Test-Suite test-both-strict
cereal >= 0.4,
deepseq >= 1.2 && < 1.4,
- lens >= 3.10 && < 4,
+ lens >= 4 && < 5,
safecopy >= 0.8 && < 0.9,
enummapmap
View
@@ -96,9 +96,4 @@ main =
let testAt2 :: ID1 -> ID2 -> TestEmm2 -> Bool
testAt2 i1 i2 emm =
emm ^.at (i2 :& K i1) == EMM.lookup (i2 :& K i1) emm
- testContains2 :: ID1 -> ID2 -> TestEmm2 -> Bool
- testContains2 i1 i2 emm =
- emm ^.contains (i2 :& K i1) == EMM.member (i2 :& K i1) emm
prop "Lens.At instance returns same result as lookup Level 2" testAt2
- prop "Lens.Contains instance returns same result as member Level 2"
- testContains2
View
@@ -10,7 +10,7 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
import Control.Arrow (first)
-import Control.Lens ((^.), at, contains, iall, imap)
+import Control.Lens ((^.), at, iall, imap)
import Control.Exception
import Control.Monad (liftM, liftM2)
import qualified Data.Foldable as Foldable
@@ -453,13 +453,6 @@ main =
testAt2 i1 i2 emm =
emm ^.at (i2 :& K i1) == EMM.lookup (i2 :& K i1) emm
- testContains1 :: ID1 -> TestEmm1 -> Bool
- testContains1 i emm = emm ^.contains (K i) == EMM.member (K i) emm
-
- testContains2 :: ID1 -> ID2 -> TestEmm2 -> Bool
- testContains2 i1 i2 emm =
- emm ^.contains (i2 :& K i1) == EMM.member (i2 :& K i1) emm
-
testImap1 :: TestEmm1 -> Bool
testImap1 emm = EMM.mapWithKey g emm == imap g emm
where
@@ -476,10 +469,6 @@ main =
prop "Lens.At instance returns same result as lookup Level 1" testAt1
prop "Lens.At instance returns same result as lookup Level 2" testAt2
- prop "Lens.Contains instance returns same result as member Level 1"
- testContains1
- prop "Lens.Contains instance returns same result as member Level 2"
- testContains2
prop "Lens.FunctorWithIndex Level 1" testImap1
prop "Lens.FunctorWithIndex Level 2" testImap2
prop "Lens.FoldableWithIndex Level 1" testIall

0 comments on commit 3da9e7d

Please sign in to comment.