Add setSwap combinator

With a linear lens, we cannot linearly set the value at the lens site
in general, however, we can swap the value at the lens site for
another, which we get out of the operation.

Ported from #79.

Author: aspiwack

src/Control/Optics/Linear/Internal.hs

@@ -23,11 +23,11 @@ module Control.Optics.Linear.Internal
   , _Just, _Nothing
   , traversed
     -- * Using optics
-  , get, set, gets
+  , get, set, gets, setSwap
   , match, build
   , over, over'
   , traverseOf, traverseOf'
-  , lengthOf
+  , toListOf, lengthOf
   , withIso, withPrism
     -- * Constructing optics
   , iso, prism
@@ -38,6 +38,7 @@ import qualified Control.Arrow as NonLinear
 import qualified Data.Bifunctor.Linear as Bifunctor
 import Data.Bifunctor.Linear (SymmetricMonoidal)
 import Data.Profunctor.Linear
+import Data.Functor.Compose hiding (getCompose)
 import Data.Functor.Linear
 import qualified Data.Profunctor.Kleisli.Linear as Linear
 import Data.Void
@@ -97,6 +98,9 @@ over (Optical l) f = getLA (l (LA f))
 traverseOf :: Optic_ (Linear.Kleisli f) a b s t -> (a #-> f b) -> s #-> f t
 traverseOf (Optical l) f = Linear.runKleisli (l (Linear.Kleisli f))
 
+toListOf :: Optic_ (NonLinear.Kleisli (Const [a])) a b s t -> s -> [a]
+toListOf l = gets l (\a -> [a])
+
 get :: Optic_ (NonLinear.Kleisli (Const a)) a b s t -> s -> a
 get l = gets l P.id
 
@@ -106,6 +110,12 @@ gets (Optical l) f s = getConst' (NonLinear.runKleisli (l (NonLinear.Kleisli (Co
 set :: Optic_ (->) a b s t -> b -> s -> t
 set (Optical l) x = l (const x)
 
+setSwap :: Optic_ (Linear.Kleisli (Compose (LinearArrow b) ((,) a))) a b s t -> s #-> b #-> (a, t)
+setSwap (Optical l) s = getLA (getCompose (Linear.runKleisli (l (Linear.Kleisli (\a -> Compose (LA (\b -> (a,b)))))) s))
+  where
+    getCompose :: Compose f g a #-> f (g a)
+    getCompose (Compose x) = x
+
 match :: Optic_ (Market a b) a b s t -> s #-> Either t a
 match (Optical l) = snd (runMarket (l (Market id Right)))
 

src/Data/Functor/Linear/Internal.hs

@@ -5,6 +5,7 @@ module Data.Functor.Linear.Internal where
 
 import Prelude.Linear.Internal
 import Prelude (Maybe(..), Either(..))
+import Data.Functor.Compose
 import Data.Functor.Const
 import Data.Monoid.Linear
 import Data.Functor.Identity
@@ -97,6 +98,14 @@ instance Applicative Identity where
   pure = Identity
   Identity f <*> Identity x = Identity (f x)
 
+instance (Functor f, Functor g) => Functor (Compose f g) where
+  fmap f (Compose x) = Compose (fmap (fmap f) x)
+
+instance (Applicative f, Applicative g) => Applicative (Compose f g) where
+   pure x = Compose (pure (pure x))
+   (Compose f) <*> (Compose x) = Compose (liftA2 (<*>) f x)
+   liftA2 f (Compose x) (Compose y) = Compose (liftA2 (liftA2 f) x y)
+
 ---------------------------------
 -- Monad transformer instances --
 ---------------------------------