Replace Data.Bifunctor.These and Data.Align with the these package.

semantic-diff.cabal

@@ -18,8 +18,6 @@ library
                      , Category
                      , Control.Comonad.Cofree
                      , Control.Monad.Free
-                     , Data.Align
-                     , Data.Bifunctor.These
                      , Data.Copointed
                      , Data.Functor.Both
                      , Data.Option
@@ -56,6 +54,7 @@ library
                      , mtl
                      , text >= 1.2.1.3
                      , text-icu
+                     , these
                      , tree-sitter-parsers
                      , vector
   default-language:    Haskell2010
@@ -85,6 +84,7 @@ test-suite semantic-diff-test
                      , quickcheck-text
                      , semantic-diff
                      , text >= 1.2.1.3
+                     , these
   if os(darwin)
     ghc-options:       -threaded -rtsopts -with-rtsopts=-N -j
   else

src/Alignment.hs

@@ -15,13 +15,13 @@ import Control.Monad.Free
 import Data.Align
 import Data.Biapplicative
 import Data.Bifunctor.Join
-import Data.Bifunctor.These
 import Data.Copointed
 import Data.Foldable
 import Data.Functor.Both as Both
 import Data.Functor.Identity
 import Data.Maybe
 import Data.Monoid
+import Data.These
 import Diff
 import Info
 import Patch
@@ -81,8 +81,8 @@ alignChildrenInRanges getRange ranges children
   | Just headRanges <- sequenceL $ listToMaybe <$> ranges
   , (intersecting, nonintersecting) <- spanAndSplitFirstLines (intersects getRange headRanges) children
   , (thisLine, nextLines) <- foldr (\ (this, next) (these, nexts) -> (this : these, next ++ nexts)) ([], []) intersecting
-  , thisRanges <- fromMaybe headRanges $ const <$> headRanges `applyThese` catThese (thisLine ++ nextLines)
-  , merged <- pairRangesWithLine thisRanges (modifyJoin (uncurry These . fromThese [] []) (catThese thisLine))
+  , thisRanges <- fromMaybe headRanges $ const <$> headRanges `applyThese` Alignment.catThese (thisLine ++ nextLines)
+  , merged <- pairRangesWithLine thisRanges (modifyJoin (uncurry These . fromThese [] []) (Alignment.catThese thisLine))
   , advance <- fromMaybe (drop 1, drop 1) $ fromThese id id . runJoin . (drop 1 <$) <$> listToMaybe nextLines
   , (nextRanges, nextChildren, nextLines) <- alignChildrenInRanges getRange (modifyJoin (uncurry bimap advance) ranges) (nextLines : nonintersecting)
   = (nextRanges, nextChildren, merged : nextLines)
@@ -123,6 +123,9 @@ applyThese fg ab = Join <$> runJoin fg `apThese` runJoin ab
 modifyJoin :: (p a a -> q b b) -> Join p a -> Join q b
 modifyJoin f = Join . f . runJoin
 
+instance Bicrosswalk t => Crosswalk (Join t) where
+  crosswalk f = fmap Join . bicrosswalk f f . runJoin
+
 -- | Given a pair of Maybes, produce a These containing Just their values, or Nothing if they haven’t any.
 maybeThese :: Maybe a -> Maybe b -> Maybe (These a b)
 maybeThese (Just a) (Just b) = Just (These a b)

src/Data/Align.hs

@@ -1,84 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-module Data.Align where
-
-import Data.Bifunctor.Join
-import Data.Bifunctor.These
-import Data.Function
-import Data.Functor.Identity
-
--- | A functor which can be aligned, essentially the union of (potentially) asymmetrical values.
--- |
--- | For example, this allows a zip over lists which pads out the shorter side with a default value.
-class Functor f => Align f where
-  -- | The empty value. The identity value for `align` (modulo the `This` or `That` constructor wrapping the results).
-  nil :: f a
-  -- | Combine two structures into a structure of `These` holding pairs of values in `These` where they overlap, and individual values in `This` and `That` elsewhere.
-  -- |
-  -- | Analogous with `zip`.
-  align :: f a -> f b -> f (These a b)
-  align = alignWith id
-  -- | Combine two structures into a structure by applying a function to pairs of values in `These` where they overlap, and individual values in `This` and `That` elsewhere.
-  -- |
-  -- | Analogous with `zipWith`.
-  alignWith :: (These a b -> c) -> f a -> f b -> f c
-  alignWith f a b = f <$> align a b
-
-instance Align [] where
-  nil = []
-  alignWith f as [] = f . This <$> as
-  alignWith f [] bs = f . That <$> bs
-  alignWith f (a:as) (b:bs) = f (These a b) : alignWith f as bs
-
-instance Align Maybe where
-  nil = Nothing
-  align (Just a) (Just b) = Just (These a b)
-  align Nothing (Just b) = Just (That b)
-  align (Just a) Nothing = Just (This a)
-  align _ _ = Nothing
-
--- | A functor which can be traversed through an `Align`able functor, inverting the nesting of one in the other, given some default value.
--- |
--- | Analogous with `zip`, in that it can e.g. turn a tuple of lists into a list of tuples.
-class Functor t => TotalCrosswalk t where
-  -- | Given some default value, embed a structure into an `Align`able functor by mapping its elements into that functor and convoluting (inverting the embedding).
-  tcrosswalk :: Align f => t b -> (a -> f b) -> t a -> f (t b)
-  tcrosswalk d f = tsequenceL d . fmap f
-
-  -- | Given some default value, convolute (invert the embedding of) a structure over an `Align`able functor.
-  tsequenceL :: Align f => t a -> t (f a) -> f (t a)
-  tsequenceL d = tcrosswalk d id
-
-instance TotalCrosswalk Identity where
-  tcrosswalk _ f = fmap Identity . f . runIdentity
-
-class Functor t => Crosswalk t where
-  -- | Embed a structure into an `Align`able functor by mapping its elements into that functor and convoluting (inverting the embedding).
-  crosswalk :: Align f => (a -> f b) -> t a -> f (t b)
-  crosswalk f = sequenceL . fmap f
-
-  -- | Convolute (invert the embedding of) a structure over an `Align`able functor.
-  sequenceL :: Align f => t (f a) -> f (t a)
-  sequenceL = crosswalk id
-
-instance Crosswalk Identity where
-  crosswalk f = fmap Identity . f . runIdentity
-
-instance Crosswalk (Join These) where
-  crosswalk f = these (fmap (Join . This) . f) (fmap (Join . That) . f) (alignWith Join `on` f) . runJoin
-
-instance Crosswalk [] where
-  crosswalk f l | (a : as) <- l = alignWith (these pure id (:)) (f a) (crosswalk f as)
-                | otherwise = nil
-
-
-class Align f => Unalign f where
-  unalign :: f (These a b) -> (f (Maybe a), f (Maybe b))
-  unalign x = (left <$> x, right <$> x)
-    where left = these Just (const Nothing) (curry (Just . fst))
-          right = these (const Nothing) Just (curry (Just . snd))
-
-instance Unalign [] where
-  unalign = foldr (these this that them) ([], [])
-    where this l ~(ls,rs) = (Just l : ls, Nothing : rs)
-          that r ~(ls,rs) = (Nothing : ls, Just r : rs)
-          them l r ~(ls,rs) = (Just l : ls, Just r : rs)

src/Data/Bifunctor/These.hs

@@ -1,36 +0,0 @@
-module Data.Bifunctor.These where
-
-import Data.Bifunctor
-import Data.Bifoldable
-import Data.Bitraversable
-
-data These a b = This a | That b | These a b
-  deriving (Eq, Show)
-
--- | Eliminate These by case analysis.
-these :: (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
-these f _ _ (This this) = f this
-these _ f _ (That that) = f that
-these _ _ f (These this that) = f this that
-
--- | Return a pair of values given These and defaults for either side.
-fromThese :: a -> b -> These a b -> (a, b)
-fromThese a b = these (flip (,) b) ((,) a) (,)
-
-
-mergeThese :: (a -> a -> a) -> These a a -> a
-mergeThese = these id id
-
-
--- Instances
-
-instance Bifunctor These where
-  bimap f g = these (This . f) (That . g) ((. g) . These . f)
-
-instance Bifoldable These where
-  bifoldMap f g = these f g ((. g) . mappend . f)
-
-instance Bitraversable These where
-  bitraverse f _ (This a) = This <$> f a
-  bitraverse _ g (That b) = That <$> g b
-  bitraverse f g (These a b) = These <$> f a <*> g b

src/Data/Functor/Both.hs

@@ -3,7 +3,7 @@ module Data.Functor.Both where
 
 import Data.Bifunctor
 import Data.Bifunctor.Join
-import Data.Bifunctor.These
+import Data.These
 import Data.Maybe
 import Prelude hiding (zipWith, fst, snd)
 import qualified Prelude

src/Patch.hs

@@ -1,6 +1,6 @@
 module Patch where
 
-import Data.Bifunctor.These
+import Data.These
 
 -- | An operation to replace, insert, or delete an item.
 data Patch a =

src/Renderer/JSON.hs

@@ -11,11 +11,11 @@ import Control.Monad.Free
 import Data.Aeson hiding (json)
 import Data.Aeson.Encode
 import Data.Bifunctor.Join
-import Data.Bifunctor.These
 import Data.OrderedMap hiding (fromList)
 import Data.Text.Lazy (toStrict)
 import Data.Text.Lazy.Builder (toLazyText)
 import qualified Data.Text as T
+import Data.These
 import Data.Vector hiding (toList)
 import Diff
 import Info

src/Renderer/Patch.hs

@@ -14,12 +14,12 @@ import Renderer
 import Source hiding ((++), break)
 import SplitDiff
 import Data.Bifunctor.Join
-import Data.Bifunctor.These
 import Data.Functor.Both as Both
 import Data.List
 import Data.Maybe
 import Data.Monoid
 import Data.Text (pack, Text)
+import Data.These
 
 -- | Render a timed out file as a truncated diff.
 truncatePatch :: DiffArguments -> Both SourceBlob -> Text

src/Renderer/Split.hs

@@ -6,12 +6,12 @@ import Category
 import Control.Comonad.Cofree
 import Control.Monad.Free
 import Data.Bifunctor.Join
-import Data.Bifunctor.These
 import Data.Foldable
 import Data.Functor.Both
 import Data.Maybe
 import Data.Monoid
 import qualified Data.Text.Lazy as TL
+import Data.These
 import Diff
 import Info
 import Prelude hiding (div, head, span, fst, snd)

test/AlignmentSpec.hs

@@ -11,9 +11,9 @@ import Control.Arrow
 import Control.Comonad.Cofree
 import Control.Monad.Free
 import Data.Bifunctor.Join
-import Data.Bifunctor.These
 import Data.Functor.Both as Both
 import Data.Functor.Identity
+import Data.These
 import Diff
 import Info
 import Patch