Merge branch 'data-dot-adjoined' into adjoin-associatively

# Conflicts:
#	src/Alignment.hs

src/Alignment.hs

@@ -1,5 +1,14 @@
 {-# LANGUAGE RankNTypes #-}
-module Alignment where
+module Alignment
+( adjoinRows
+, alignRows
+, hasChanges
+, linesInRangeOfSource
+, numberedRows
+, splitAbstractedTerm
+, splitDiffByLines
+, Row
+) where
 
 import Category
 import Control.Arrow
@@ -56,6 +65,7 @@ splitAbstractedTerm align makeTerm sources infos syntax = case syntax of
   Keyed children -> adjoinChildren sources infos align (constructor (Keyed . Map.fromList)) (Map.toList children)
   where constructor with info = makeTerm info . with
 
+-- | Adjoin a branch term’s lines, wrapping children & context in branch nodes using a constructor.
 adjoinChildren :: (Copointed c, Functor c, Applicative f, Foldable f) => f (Source Char) -> f Info -> AlignFunction f -> (Info -> [c a] -> outTerm) -> [c [f (Line (a, Range))]] -> [f (Line (outTerm, Range))]
 adjoinChildren sources infos align constructor children =
   fmap wrap . foldr (adjoinRows align) [] $
@@ -66,6 +76,7 @@ adjoinChildren sources infos align constructor children =
         leadingContext = fmap (fmap ((,) Nothing)) <$> (linesInRangeOfSource <$> (Range <$> (start <$> ranges) <*> next) <*> sources)
         wrap = (wrapLineContents <$> (makeBranchTerm constructor <$> categories <*> next) <*>)
 
+-- | Accumulate the lines of and between a branch term’s children.
 childLines :: (Copointed c, Functor c, Applicative f, Foldable f) => f (Source Char) -> AlignFunction f -> c [f (Line (a, Range))] -> ([f (Line (Maybe (c a), Range))], f Int) -> ([f (Line (Maybe (c a), Range))], f Int)
 -- We depend on source ranges increasing monotonically. If a child invalidates that, e.g. if it’s a move in a Keyed node, we don’t output rows for it in this iteration. (It will still show up in the diff as context rows.) This works around https://github.com/github/semantic-diff/issues/488.
 childLines sources align child (followingLines, next) | or $ (>) . end <$> childRanges <*> next = (followingLines, next)

src/Data/Align.hs

@@ -3,17 +3,30 @@ module Data.Align where
 import Data.Bifunctor.These
 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 = []
-  align as bs | la < lb = (That <$> take (lb - la) bs) ++ align as (drop (lb - la) bs)
-              | la > lb = (This <$> take (la - lb) as) ++ align (drop (la - lb) as) bs
+           -- | The second list is longer, so map its prefix into `That` and zip the rest.
+  align as bs | la < lb, (prefix, overlap) <- splitAt (lb - la) bs = (That <$> prefix) ++ zipWith These as overlap
+           -- | The first list is longer, so map its prefix into `This` and zip the rest.
+              | la > lb, (prefix, overlap) <- splitAt (la - lb) as = (This <$> prefix) ++ zipWith These overlap bs
+           -- | They’re of equal length, so zip into `These`.
               | otherwise = zipWith These as bs
               where (la, lb) = (length as, length bs)
 
@@ -25,10 +38,15 @@ instance Align Maybe where
               | otherwise = Nothing
 
 
+-- | A functor which can be traversed through an `Align`able functor, inverting the nesting of one in the other.
+-- |
+-- | Analogous with `zip`, in that it can e.g. turn a tuple of lists into a list of tuples.
 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
 

src/Renderer/JSON.hs

@@ -61,7 +61,11 @@ instance ToJSON (Term leaf Info) where
 
 lineFields :: KeyValue kv => Int -> Line (SplitDiff leaf Info, Range) -> [kv]
 lineFields n line | isEmpty line = []
-                  | otherwise = [ "number" .= n, "terms" .= unLine (Prelude.fst <$> line), "range" .= unionRanges (Prelude.snd <$> line), "hasChanges" .= hasChanges (Prelude.fst <$> line) ]
+                  | otherwise = [ "number" .= n
+                                , "terms" .= unLine (Prelude.fst <$> line)
+                                , "range" .= unionRanges (Prelude.snd <$> line)
+                                , "hasChanges" .= hasChanges (Prelude.fst <$> line)
+                                ]
 
 termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv]
 termFields (Info range categories) syntax = "range" .= range : "categories" .= categories : case syntax of

src/Renderer/Split.hs

@@ -112,7 +112,11 @@ instance ToMarkup (Renderable (Source Char, SplitDiff a Info)) where
 
 
 instance ToMarkup a => ToMarkup (Renderable (Bool, Int, Line a)) where
-  toMarkup (Renderable (_, _, line)) | isEmpty line = td mempty ! A.class_ (stringValue "blob-num blob-num-empty empty-cell") <> td mempty ! A.class_ (stringValue "blob-code blob-code-empty empty-cell") <> string "\n"
-  toMarkup (Renderable (hasChanges, num, line))
-    = td (string $ show num) ! A.class_ (stringValue $ if hasChanges then "blob-num blob-num-replacement" else "blob-num")
-    <> td (mconcat $ toMarkup <$> unLine line) ! A.class_ (stringValue $ if hasChanges then "blob-code blob-code-replacement" else "blob-code") <> string "\n"
+  toMarkup (Renderable (_, _, line)) | isEmpty line =
+    td mempty ! A.class_ (stringValue "blob-num blob-num-empty empty-cell")
+    <> td mempty ! A.class_ (stringValue "blob-code blob-code-empty empty-cell")
+    <> string "\n"
+  toMarkup (Renderable (hasChanges, num, line)) =
+    td (string $ show num) ! A.class_ (stringValue $ if hasChanges then "blob-num blob-num-replacement" else "blob-num")
+    <> td (mconcat $ toMarkup <$> unLine line) ! A.class_ (stringValue $ if hasChanges then "blob-code blob-code-replacement" else "blob-code")
+    <> string "\n"

test/AlignmentSpec.hs

@@ -108,11 +108,6 @@ spec = parallel $ do
           \ source -> splitAbstractedTerm alignRows makeTerm (pure source) (pure $ Info (totalRange source) mempty) (Indexed []) `shouldBe` [
             both (pure (makeTerm (Info (totalRange source) mempty) $ Indexed [], Range 0 (length source))) (pure (makeTerm (Info (totalRange source) mempty) $ Indexed [], Range 0 (length source))) ]
 
-  describe "splitPatchByLines" $ do
-    prop "starts at initial indices" $
-      \ patch sources -> let indices = length <$> sources in
-        fmap start . maybeFirst . Maybe.catMaybes <$> Both.unzip (fmap maybeFirst . fmap (fmap Prelude.snd) <$> splitPatchByLines ((Source.++) <$> sources <*> sources) (patchWithBoth patch (leafWithRangeInSource <$> sources <*> (Range <$> indices <*> ((2 *) <$> indices))))) `shouldBe` (<$) <$> indices <*> unPatch patch
-
     where
       isEmptyRow = and . fmap isEmpty