forgot to stage some stuff

Author: b-mehta

src/Data/Profunctor/Linear.hs

@@ -159,3 +159,31 @@ data Exchange a b s t = Exchange (s ->. a) (b ->. t)
 instance Profunctor (Exchange a b) where
   dimap f g (Exchange p q) = Exchange (p . f) (g . q)
 
+data Top = forall x. Top x
+instance Show Top where
+  show (Top _) = "something"
+instance Control.Functor (Const (Top, a)) where
+  fmap f (Const (Top t, x)) = Const (Top (t,f), x)
+instance Monoid a => Control.Applicative (Const (Top, a)) where
+  pure x = Const (Top x, mempty)
+  Const (Top a, x) <*> Const (Top b, y) = Const (Top (a,b), x <> y)
+
+-- TODO: pick a more sensible name for this
+newtype MyFunctor a b t = MyFunctor (b ->. (a, t))
+runMyFunctor :: MyFunctor a b t ->. b ->. (a, t)
+runMyFunctor (MyFunctor f) = f
+
+instance Data.Functor (MyFunctor a b) where
+  fmap f (MyFunctor g) = MyFunctor (getLA (second (LA f)) . g)
+instance Control.Functor (MyFunctor a b) where
+  fmap f (MyFunctor g) = MyFunctor (thing f . g)
+    where thing :: (c ->. d) ->. (e, c) ->. (e, d)
+          thing k (x,y) = (x, k y)
+
+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/Prelude/Linear.hs

@@ -6,6 +6,9 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE RankNTypes #-}
 
+-- TODO: move the Functor (Either e) instance somewhere more sensible
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Prelude.Linear
   ( -- * Standard 'Prelude' function with linear types
     -- $linearized-prelude
@@ -18,7 +21,9 @@ module Prelude.Linear
   , (.)
   , either
   , maybe
-  , forget
+  , eta
+  , Semigroup(..)
+  , Monoid(..)
     -- * Unrestricted
     -- $ unrestricted
   , Unrestricted(..)
@@ -37,6 +42,7 @@ module Prelude.Linear
   , module Prelude
   ) where
 
+import Data.Semigroup.Linear
 import qualified Data.Functor.Linear as Data
 import Data.Vector.Linear (V)
 import qualified Data.Vector.Linear as V
@@ -56,6 +62,8 @@ import Prelude hiding
   , Applicative(..)
   , Monad(..)
   , Traversable(..)
+  , Semigroup(..)
+  , Monoid(..)
   )
 import Prelude.Linear.Internal.Simple
 import qualified Unsafe.Linear as Unsafe
@@ -73,10 +81,10 @@ maybe x _ Nothing = x
 maybe _ f (Just y) = f y
 
 -- XXX: temporary
--- | Convenience operator when a higher-order function expects a non-linear
--- arrow but we have a linear arrow
-forget :: (a ->. b) ->. a -> b
-forget f x = f x
+-- | Convenience operator which does eta expansion for when a higher-order
+-- function expects a non-linear arrow but we have a linear arrow
+eta :: (a ->. b) ->. a -> b
+eta f x = f x
 
 -- $ unrestricted