Define BlobPair as a newtype.

src/Control/Effect/Parse.hs

@@ -10,7 +10,7 @@ module Control.Effect.Parse
 import Control.Effect.Carrier
 import Control.Effect.Error
 import Control.Exception (SomeException)
-import Data.Bifunctor.Join
+import Data.Bitraversable
 import Data.Blob
 import Data.Language
 import qualified Data.Map as Map
@@ -56,5 +56,5 @@ parsePairWith
   -> BlobPair                                                     -- ^ The blob pair to parse.
   -> m a
 parsePairWith parsers with blobPair = case Map.lookup (languageForBlobPair blobPair) parsers of
-  Just (SomeParser parser) -> traverse (parse parser) blobPair >>= with . runJoin
+  Just (SomeParser parser) -> bitraverse (parse parser) (parse parser) (getBlobPair blobPair) >>= with
   _                        -> noLanguageForBlob (pathForBlobPair blobPair)

src/Data/Blob.hs

@@ -13,7 +13,7 @@ module Data.Blob
 , nullBlob
 , sourceBlob
 , noLanguageForBlob
-, type BlobPair
+, BlobPair(..)
 , pattern Diffing
 , pattern Inserting
 , pattern Deleting
@@ -101,7 +101,8 @@ noLanguageForBlob blobPath = throwError (SomeException (NoLanguageForBlob blobPa
 
 -- | Represents a blobs suitable for diffing which can be either a blob to
 -- delete, a blob to insert, or a pair of blobs to diff.
-type BlobPair = Join These Blob
+newtype BlobPair = BlobPair { getBlobPair :: These Blob Blob }
+  deriving (Eq, Show)
 
 instance FromJSON BlobPair where
   parseJSON = withObject "BlobPair" $ \o -> do
@@ -114,13 +115,13 @@ instance FromJSON BlobPair where
       _                 -> Prelude.fail "Expected object with 'before' and/or 'after' keys only"
 
 pattern Diffing :: Blob -> Blob -> BlobPair
-pattern Diffing a b = Join (These a b)
+pattern Diffing a b = BlobPair (These a b)
 
 pattern Inserting :: Blob -> BlobPair
-pattern Inserting a = Join (That a)
+pattern Inserting a = BlobPair (That a)
 
 pattern Deleting :: Blob -> BlobPair
-pattern Deleting b = Join (This b)
+pattern Deleting b = BlobPair (This b)
 
 {-# COMPLETE Diffing, Inserting, Deleting #-}
 
@@ -151,7 +152,7 @@ languageTagForBlobPair pair = showLanguage (languageForBlobPair pair)
   where showLanguage = pure . (,) "language" . show
 
 pathKeyForBlobPair :: BlobPair -> FilePath
-pathKeyForBlobPair blobs = case bimap blobPath blobPath (runJoin blobs) of
+pathKeyForBlobPair blobs = case bimap blobPath blobPath (getBlobPair blobs) of
    This before -> before
    That after -> after
    These before after | before == after -> after

src/Rendering/JSON.hs

@@ -56,8 +56,8 @@ newtype JSONStat = JSONStat { jsonStatBlobs :: BlobPair }
   deriving (Eq, Show)
 
 instance ToJSON JSONStat where
-  toJSON JSONStat{..} = object ("path" .= pathKeyForBlobPair jsonStatBlobs : toJSONFields (these Delete Insert Replace (runJoin jsonStatBlobs)))
-  toEncoding JSONStat{..} = pairs (fold ("path" .= pathKeyForBlobPair jsonStatBlobs : toJSONFields (these Delete Insert Replace (runJoin jsonStatBlobs))))
+  toJSON JSONStat{..} = object ("path" .= pathKeyForBlobPair jsonStatBlobs : toJSONFields (these Delete Insert Replace (getBlobPair jsonStatBlobs)))
+  toEncoding JSONStat{..} = pairs (fold ("path" .= pathKeyForBlobPair jsonStatBlobs : toJSONFields (these Delete Insert Replace (getBlobPair jsonStatBlobs))))
 
 -- | Render a term to a value representing its JSON.
 renderJSONTerm :: ToJSON a => Blob -> a -> JSON "trees" SomeJSON

src/Semantic/Api/Diffs.hs

@@ -184,7 +184,7 @@ decoratingDiffWith
   -> BlobPair                                                   -- ^ The blob pair to parse.
   -> m output
 decoratingDiffWith parsers decorate render blobPair = parsePairWith parsers (render <=< diffTerms blobPair . bimap (decorate blobL) (decorate blobR)) blobPair where
-  (blobL, blobR) = fromThese errorBlob errorBlob (runJoin blobPair)
+  (blobL, blobR) = fromThese errorBlob errorBlob (getBlobPair blobPair)
   errorBlob = Prelude.error "evaluating blob on absent side"
 
 diffTerms :: (DiffTerms term, Member Telemetry sig, Carrier sig m, MonadIO m)