Top monoid and misc fixes

Author: b-mehta

src/Control/Optics/Linear/Internal.hs

@@ -24,9 +24,9 @@ module Control.Optics.Linear.Internal
   , _Just, _Nothing
   , ptraversed, dtraversed
   , both, both'
-  , get', gets', set'
     -- * Using optics
   , get, set, gets
+  , get', gets', set', set''
   , match, match', build
   , preview
   , over, over'
@@ -42,15 +42,13 @@ module Control.Optics.Linear.Internal
 import qualified Control.Arrow as NonLinear
 import qualified Data.Bifunctor.Linear as Bifunctor
 import Data.Bifunctor.Linear (SymmetricMonoidal)
-import Data.Monoid
+import Data.Monoid (First(..), Sum(..))
 import Data.Functor.Const
 import Data.Functor.Linear
 import Data.Profunctor.Linear
-import Data.Functor.Linear
 import qualified Data.Profunctor.Kleisli.Linear as Linear
 import Data.Void
-import Prelude.Linear hiding ((<$>))
--- ^ XXX: not entirely sure why the hiding is necessary here...
+import Prelude.Linear
 import qualified Prelude as P
 
 -- TODO: documentation in this module
@@ -161,8 +159,8 @@ get l = gets l P.id
 gets :: Optic_ (NonLinear.Kleisli (Const r)) a b s t -> (a -> r) -> s -> r
 gets (Optical l) f s = getConst' (NonLinear.runKleisli (l (NonLinear.Kleisli (Const P.. f))) s)
 
-preview :: Optic_ (NonLinear.Kleisli (Const (Maybe (First a)))) a b s t -> s -> Maybe a
-preview (Optical l) s = getFirst P.<$> (getConst (NonLinear.runKleisli (l (NonLinear.Kleisli (\a -> Const (Just (First a))))) s))
+preview :: Optic_ (NonLinear.Kleisli (Const (First a))) a b s t -> s -> Maybe a
+preview (Optical l) s = getFirst (getConst (NonLinear.runKleisli (l (NonLinear.Kleisli (\a -> Const (First (Just a))))) s))
 
 get' :: Optic_ (Linear.Kleisli (Const (Top, a))) a b s t -> s ->. (Top, a)
 get' l = gets' l id

src/Data/Monoid/Linear.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LinearTypes #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
 -- | = The linear monoid hierarchy
@@ -13,6 +14,7 @@ module Data.Monoid.Linear
   ( Semigroup(..)
   , Monoid(..)
   , Endo(..), appEndo
+  , Top, throw
   , module Data.Semigroup
   )
   where
@@ -72,3 +74,15 @@ instance Semigroup Any where
   Any False <> Any True = Any True
   Any True  <> Any False = Any True
   Any True  <> Any True = Any True
+
+data Top = forall x. Top x
+throw :: x ->. Top
+throw = Top
+
+instance Prelude.Semigroup Top where
+  Top x <> Top y = Top (x,y)
+instance Semigroup Top where
+  Top x <> Top y = Top (x,y)
+instance Prelude.Monoid Top where
+  mempty = Top ()
+instance Monoid Top where

src/Data/Profunctor/Kleisli/Linear.hs

@@ -49,14 +49,6 @@ instance Control.Applicative f => DWandering (Kleisli f) where
 -- profunctorial properties still hold in this weaker setting.
 -- However stronger requirements on `f` are needed for profunctorial
 -- strength, so we have fewer instances.
---
--- Category theoretic remark: duality doesn't work in the obvious way, since
--- (,) isn't the categorical product. Instead, we have a product (&), called
--- "With", defined by
--- > type With a b = forall r. Either (a ->. r) (b ->. r) ->. r
--- which satisfies the universal property of the product of `a` and `b`.
--- CoKleisli arrows are strong with respect to this monoidal structure,
--- although this might not be useful...
 newtype CoKleisli w a b = CoKleisli { runCoKleisli :: w a ->. b }
 
 instance Data.Functor f => Profunctor (CoKleisli f) where

src/Data/Profunctor/Linear.hs

@@ -99,6 +99,9 @@ instance Strong Either Void LinearArrow where
   first  (LA f) = LA $ either (Left . f) Right
   second (LA g) = LA $ either Left (Right . g)
 
+instance DWandering LinearArrow where
+  dwander (LA f) = LA (Data.fmap f)
+
 instance Profunctor (->) where
   dimap f g h x = g (h (f x))
 instance Strong (,) () (->) where

src/Foreign/Marshal/Pure.hs

@@ -60,7 +60,7 @@ import Foreign.Marshal.Utils
 import Foreign.Ptr
 import Foreign.Storable
 import Foreign.Storable.Tuple ()
-import Prelude (($), return, (<*>))
+import Prelude (($), return, (<*>), (<$>))
 import Prelude.Linear hiding (($))
 import System.IO.Unsafe
 import qualified Unsafe.Linear as Unsafe

src/Prelude/Linear.hs

@@ -46,7 +46,7 @@ import Prelude hiding
   , either
   , maybe
   , (.)
-  , Functor(..)
+  , Functor(..), (<$>)
   , Applicative(..)
   , Monad(..)
   , Traversable(..)

src/System/IO/Linear.hs

@@ -41,6 +41,7 @@ import qualified Control.Monad.Linear as Control
 import qualified Data.Functor.Linear as Data
 import GHC.Exts (State#, RealWorld)
 import Prelude.Linear hiding (IO)
+import Prelude ((<$>))
 import qualified Unsafe.Linear as Unsafe
 import qualified System.IO as System