Represent Both as Join (,).

src/Data/Functor/Both.hs

@@ -1,20 +1,20 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
 module Data.Functor.Both where
 
 import Data.Align
 import Data.Bifunctor
+import Data.Bifunctor.Join
 import Data.Bifunctor.These
 import Data.Maybe
 import Prelude hiding (zipWith, fst, snd)
 import qualified Prelude
 
 -- | A computation over both sides of a pair.
-newtype Both a = Both { runBoth :: (a, a) }
-  deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
+type Both a = Join (,) a
 
 -- | Given two operands returns a functor operating on `Both`. This is a curried synonym for Both.
 both :: a -> a -> Both a
-both = curry Both
+both = curry Join
 
 -- | Construct Both with These values & defaults.
 bothOfThese :: Both a -> These a a -> Both a
@@ -30,6 +30,10 @@ maybeBothOfThese = bothOfThese (pure Nothing) . bimap Just Just
 pairWithThese :: Both a -> These b c -> These (a, b) (a, c)
 pairWithThese = uncurry bimap . bimap (,) (,) . runBoth
 
+-- | Extract `Both` sides of a computation.
+runBoth :: Both a -> (a, a)
+runBoth = runJoin
+
 -- | Apply a function to `Both` sides of a computation.
 runBothWith :: (a -> a -> b) -> Both a -> b
 runBothWith f = uncurry f . runBoth
@@ -44,16 +48,12 @@ snd = Prelude.snd . runBoth
 
 unzip :: [Both a] -> Both [a]
 unzip = foldr pair (pure [])
-  where pair (Both (a, b)) (Both (as, bs)) = Both (a : as, b : bs)
+  where pair (Join (a, b)) (Join (as, bs)) = Join (a : as, b : bs)
 
-instance Applicative Both where
-  pure a = Both (a, a)
-  Both (f, g) <*> Both (a, b) = Both (f a, g b)
-
-instance Monoid a => Monoid (Both a) where
+instance Monoid a => Monoid (Join (,) a) where
   mempty = pure mempty
   mappend a b = mappend <$> a <*> b
 
 
-instance TotalCrosswalk Both where
+instance TotalCrosswalk (Join (,)) where
   tsequenceL d = runBothWith (alignWith (\ these -> fromMaybe <$> d <*> maybeBothOfThese these))

src/Renderer/JSON.hs

@@ -9,6 +9,7 @@ import Category
 import Control.Comonad.Cofree
 import Control.Monad.Free
 import Data.Aeson hiding (json)
+import Data.Bifunctor.Join
 import Data.ByteString.Builder
 import Data.ByteString.Lazy
 import Data.Functor.Both
@@ -46,7 +47,7 @@ instance ToJSON Range where
   toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ]
   toEncoding (Range start end) = foldable [ start,  end ]
 instance ToJSON a => ToJSON (Both a) where
-  toJSON (Both (a, b)) = Array . fromList $ toJSON <$> [ a, b ]
+  toJSON (Join (a, b)) = Array . fromList $ toJSON <$> [ a, b ]
   toEncoding = foldable
 instance ToJSON (SplitDiff leaf Info) where
   toJSON (Free (Annotated info syntax)) = object (termFields info syntax)

src/Renderer/Patch.hs

@@ -16,6 +16,7 @@ import Source hiding ((++), break)
 import SplitDiff
 import Control.Comonad.Cofree
 import Control.Monad.Free
+import Data.Bifunctor.Join
 import Data.Functor.Both as Both
 import Data.List
 import Data.Maybe
@@ -114,7 +115,7 @@ hunks _ blobs | sources <- source <$> blobs
               , sourcesNull <- runBothWith (&&) (null <$> sources)
               , sourcesEqual || sourcesNull
   = [Hunk { offset = mempty, changes = [], trailingContext = [] }]
-hunks diff blobs = hunksInRows (Both (1, 1)) $ fmap (fmap Prelude.fst) <$> splitDiffByLines (source <$> blobs) diff
+hunks diff blobs = hunksInRows (Join (1, 1)) $ fmap (fmap Prelude.fst) <$> splitDiffByLines (source <$> blobs) diff
 
 -- | Given beginning line numbers, turn rows in a split diff into hunks in a
 -- | patch.

test/ArbitraryTerm.hs

@@ -1,8 +1,10 @@
+{-# LANGUAGE FlexibleInstances #-}
 module ArbitraryTerm where
 
 import Category
 import Control.Comonad.Cofree
 import Control.Monad
+import Data.Bifunctor.Join
 import Data.Functor.Both
 import qualified Data.OrderedMap as Map
 import qualified Data.List as List
@@ -55,7 +57,7 @@ instance Categorizable CategorySet where
 instance Arbitrary CategorySet where
   arbitrary = elements [ A, B, C, D ]
 
-instance Arbitrary a => Arbitrary (Both a) where
+instance Arbitrary a => Arbitrary (Join (,) a) where
   arbitrary = both <$> arbitrary <*> arbitrary
   shrink b = both <$> (shrink (fst b)) <*> (shrink (snd b))