[#290] Add Universum.Lens module

Problem:
As in #290, we want to export lens-related operators
like `(^.)` or `(^?)`, but we don't want to depend on
`microlens` or `lens`.

Solution:
Implement those operators by ourselves, export them in
a separate module to avoid names conflict.

Remove those operators from `Universum` reexports.

README.md

@@ -178,7 +178,11 @@ Then, some commonly used types: `Map/HashMap/IntMap`, `Set/HashSet/IntSet`, `Seq
 `deepseq` is exported. For instance, if you want to force deep evaluation of some value (in IO),
 you can write `evaluateNF a`. WHNF evaluation is possible with `evaluateWHNF a`.
 
-We also reexport big chunks of these libraries: `mtl`, `stm`, `microlens`, `microlens-mtl`.
+`(.^)`, `(.~)` and some other optics-related functions and operators are exported in
+`Universum.Lens` module.
+This module is not included in `Universum` module so it requires explicit `import`.
+
+We also reexport big chunks of `mtl`, `stm`.
 
 [`Bifunctor`](http://hackage.haskell.org/package/base-4.9.1.0/docs/Data-Bifunctor.html)
 type class with useful instances is exported.

src/Universum.hs

@@ -43,6 +43,9 @@ Below is a short description of what you can find under different modules:
 * __"Universum.Function"__: almost everything from "Data.Function" module.
 * __"Universum.Functor"__: reexports from "Data.Functor", "Data.Bifunctor",
  other useful 'Functor' combinators.
+* __"Universum.Lens"__: Some operators and functions for using lenses.
+ Not exported by "Universum" module by default, so, if more functionality is needed,
+ @microlens@ or @lens@ packages can be used without conflicts of names.
 * __"Universum.Lifted"__: lifted to 'MonadIO' functions to work with console,
  files, 'IORef's, 'MVar's, etc.
 * __"Universum.List"__: big chunk of "Data.List", 'NonEmpty' type and
@@ -80,18 +83,7 @@ module Universum
  , module Universum.TypeOps
  , module Universum.VarArg
 
- -- * Lenses
- , Lens
- , Lens'
- , Traversal
- , Traversal'
- , over
- , set
- , (%~)
- , (.~)
- , (^.)
- , (^..)
- , (^?)
+ -- * Lenses, see also __"Universum.Lens"__
  , _1
  , _2
  , _3
@@ -123,24 +115,12 @@ import Universum.TypeOps
 import Universum.VarArg
 
 -- Lenses
-import qualified Lens.Micro (ASetter, Getting, over, set, (%~), (.~), (^.),
- (^..), (^?), _1, _2, _3, _4, _5)
+import qualified Lens.Micro (Getting, Lens, _1, _2, _3, _4, _5)
 import qualified Lens.Micro.Mtl (preuse, preview, use, view)
 import Lens.Micro.Internal (Field1, Field2, Field3, Field4, Field5)
 
 {-# DEPRECATED
- Lens
- , Lens'
- , Traversal
- , Traversal'
- , over
- , set
- , (%~)
- , (.~)
- , (^.)
- , (^..)
- , (^?)
- , _1
+ _1
  , _2
  , _3
  , _4
@@ -152,56 +132,19 @@ import Lens.Micro.Internal (Field1, Field2, Field3, Field4, Field5)
  "Use corresponding function from 'lens' or 'microlens' package"
 #-}
 
-type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
-type Lens' s a = Lens s s a a
-
-type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
-type Traversal' s a = Traversal s s a a
-
-over :: Lens.Micro.ASetter s t a b -> (a -> b) -> s -> t
-over = Lens.Micro.over
-
-set :: Lens.Micro.ASetter s t a b -> b -> s -> t
-set = Lens.Micro.set
-
-(%~) :: Lens.Micro.ASetter s t a b -> (a -> b) -> s -> t
-(%~) = (Lens.Micro.%~)
-
-infixr 4 %~
-
-(.~) :: Lens.Micro.ASetter s t a b -> b -> s -> t
-(.~) = (Lens.Micro..~)
-
-infixr 4 .~
-
-(^.) :: s -> Lens.Micro.Getting a s a -> a
-(^.) = (Lens.Micro.^.)
-
-infixl 8 ^.
-
-(^..) :: s -> Lens.Micro.Getting (Endo [a]) s a -> [a]
-(^..) = (Lens.Micro.^..)
-
-infixl 8 ^..
-
-(^?) :: s -> Lens.Micro.Getting (First a) s a -> Maybe a
-(^?) = (Lens.Micro.^?)
-
-infixl 8 ^?
-
-_1 :: Field1 s t a b => Lens s t a b
+_1 :: Field1 s t a b => Lens.Micro.Lens s t a b
 _1 = Lens.Micro._1
 
-_2 :: Field2 s t a b => Lens s t a b
+_2 :: Field2 s t a b => Lens.Micro.Lens s t a b
 _2 = Lens.Micro._2
 
-_3 :: Field3 s t a b => Lens s t a b
+_3 :: Field3 s t a b => Lens.Micro.Lens s t a b
 _3 = Lens.Micro._3
 
-_4 :: Field4 s t a b => Lens s t a b
+_4 :: Field4 s t a b => Lens.Micro.Lens s t a b
 _4 = Lens.Micro._4
 
-_5 :: Field5 s t a b => Lens s t a b
+_5 :: Field5 s t a b => Lens.Micro.Lens s t a b
 _5 = Lens.Micro._5
 
 preuse :: MonadState s m => Lens.Micro.Getting (First a) s a -> m (Maybe a)

src/Universum/Lens.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE Safe #-}
+
+-- | Operators and functions compatible with lens constructed with
+-- any of `lens` and `microlens` packages. Both those packages contain
+-- operators, types, and functions defined here, so you can find all related
+-- documentation there.
+
+module Universum.Lens
+ ( Lens
+ , Lens'
+ , Traversal
+ , Traversal'
+
+ , ASetter
+ , Getting
+
+ , over
+ , set
+ , get
+ , (%~)
+ , (.~)
+ , (^.)
+ , (^..)
+ , (^?)
+ ) where
+
+
+import Data.Maybe (Maybe (..))
+import Universum.Applicative
+import Universum.Function
+import Universum.Functor
+import Universum.Monoid
+
+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
+type Lens' s a = Lens s s a a
+
+type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
+type Traversal' s a = Traversal s s a a
+
+type ASetter s t a b = (a -> Identity b) -> s -> Identity t
+
+type Getting r s a = (a -> Const r a) -> s -> Const r s
+
+over :: ASetter s t a b -> (a -> b) -> s -> t
+over setter f = runIdentity . setter (Identity . f)
+
+set :: ASetter s t a b -> b -> s -> t
+set setter f = over setter (const f)
+
+get :: s -> Getting a s a -> a
+get s getter = getConst $ getter Const s
+
+(%~) ::ASetter s t a b -> (a -> b) -> s -> t
+(%~) = over
+
+infixr 4 %~
+
+(.~) :: ASetter s t a b -> b -> s -> t
+(.~) = set
+
+infixr 4 .~
+
+(^.) :: s -> Getting a s a -> a
+(^.) = get
+
+infixl 8 ^.
+
+(^..) :: s -> Getting (Endo [a]) s a -> [a]
+s ^.. getter =
+ let endo = getConst $ getter (\x -> Const $ Endo (x :)) s in
+ appEndo endo []
+
+infixl 8 ^..
+
+(^?) :: s -> Getting (First a) s a -> Maybe a
+s ^? getter = getFirst $ getConst $ getter (Const . pure) s
+
+infixl 8 ^?

universum.cabal

@@ -70,6 +70,7 @@ library
  Universum.Functor
  Universum.Functor.Fmap
  Universum.Functor.Reexport
+ Universum.Lens
  Universum.Lifted
  Universum.Lifted.Concurrent
  Universum.Lifted.Env