adjoinRowsBy applies Both MaybeOpen tests.

src/Alignment.hs

@@ -80,7 +80,7 @@ splitAnnotatedByLines sources ranges categories syntax = case syntax of
           runBoth (fmap pure <$> (actualLineRanges <$> ranges <*> sources))
 
         adjoin :: Has f => [Row (Either Range (f (SplitDiff leaf Info)))] -> [Row (Either Range (f (SplitDiff leaf Info)))]
-        adjoin = reverse . foldl (adjoinRowsBy (openEither (openRange . fst $ runBoth sources) (openDiff . fst $ runBoth sources)) (openEither (openRange . snd $ runBoth sources) (openDiff . snd $ runBoth sources))) []
+        adjoin = reverse . foldl (adjoinRowsBy (openEither <$> (openRange <$> sources) <*> (openDiff <$> sources))) []
 
         adjoinChildRows :: Has f => ([f (SplitDiff leaf Info)] -> Syntax leaf (SplitDiff leaf Info)) -> [f (Diff leaf Info)] -> [Row (SplitDiff leaf Info)]
         adjoinChildRows constructor children = let (rows, previous) = foldl childRows ([], start <$> ranges) children in

src/Row.hs

@@ -18,25 +18,25 @@ wrapRowContents transform row = uncurry Row . runBoth $ wrapLineContents <$> tra
 
 -- | Given functions that determine whether an item is open, add a row to a
 -- | first open, non-empty item in a list of rows, or add it as a new row.
-adjoinRowsBy :: MaybeOpen a -> MaybeOpen a -> [Row a] -> Row a -> [Row a]
+adjoinRowsBy :: Both (MaybeOpen a) -> [Row a] -> Row a -> [Row a]
-adjoinRowsBy _ _ [] row = [row]
+adjoinRowsBy _ [] row = [row]
 
-adjoinRowsBy f g rows (Row left' right') | Both (Just _, Just _) <- openLineBy <$> Both (f, g) <*> (Both.unzip $ unRow <$> rows) = Both.zipWith Row $ both <*> Both (left', right')
+adjoinRowsBy f rows (Row left' right') | Both (Just _, Just _) <- openLineBy <$> f <*> (Both.unzip $ unRow <$> rows) = Both.zipWith Row $ both <*> Both (left', right')
-  where both = adjoinLinesBy <$> Both (f, g) <*> (Both.unzip $ unRow <$> rows)
+  where both = adjoinLinesBy <$> f <*> (Both.unzip $ unRow <$> rows)
 
-adjoinRowsBy f _ rows (Row left' right') | Just _ <- openLineBy f $ unLeft <$> rows = case right' of
+adjoinRowsBy (Both (f, _)) rows (Row left' right') | Just _ <- openLineBy f $ unLeft <$> rows = case right' of
   EmptyLine -> rest
   _ -> Row EmptyLine right' : rest
   where rest = Prelude.zipWith Row (lefts left') rights
         (lefts, rights) = first (adjoinLinesBy f) . runBoth $ Both.unzip $ unRow <$> rows
 
-adjoinRowsBy _ g rows (Row left' right') | Just _ <- openLineBy g $ unRight <$> rows = case left' of
+adjoinRowsBy (Both (_, g)) rows (Row left' right') | Just _ <- openLineBy g $ unRight <$> rows = case left' of
   EmptyLine -> rest
   _ -> Row left' EmptyLine : rest
   where rest = Prelude.zipWith Row lefts (rights right')
         (lefts, rights) = second (adjoinLinesBy g) . runBoth $ Both.unzip $ unRow <$> rows
 
-adjoinRowsBy _ _ rows row = row : rows
+adjoinRowsBy _ rows row = row : rows
 
 
 instance Show a => Show (Row a) where

test/AlignmentSpec.hs

@@ -62,24 +62,24 @@ spec = parallel $ do
 
   describe "adjoinRowsBy" $ do
     prop "is identity on top of no rows" $
-      \ a -> adjoinRowsBy openMaybe openMaybe [] a == [ a ]
+      \ a -> adjoinRowsBy (pure openMaybe) [] a == [ a ]
 
     prop "appends onto open rows" $
       forAll ((arbitrary `suchThat` isOpenBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isOpenBy openMaybe)) $
         \ (a@(Row a1 b1), b@(Row a2 b2)) ->
-          adjoinRowsBy openMaybe openMaybe [ a ] b `shouldBe` [ Row (makeLine $ unLine a1 ++ unLine a2) (makeLine $ unLine b1 ++ unLine b2) ]
+          adjoinRowsBy (pure openMaybe) [ a ] b `shouldBe` [ Row (makeLine $ unLine a1 ++ unLine a2) (makeLine $ unLine b1 ++ unLine b2) ]
 
     prop "does not append onto closed rows" $
       forAll ((arbitrary `suchThat` isClosedBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isClosedBy openMaybe)) $
-        \ (a, b) -> adjoinRowsBy openMaybe openMaybe [ a ] b `shouldBe` [ b, a ]
+        \ (a, b) -> adjoinRowsBy (pure openMaybe) [ a ] b `shouldBe` [ b, a ]
 
     prop "does not promote elements through empty lines onto closed lines" $
       forAll ((arbitrary `suchThat` isClosedBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isClosedBy openMaybe)) $
-        \ (a, b) -> adjoinRowsBy openMaybe openMaybe [ Row EmptyLine EmptyLine, a ] b `shouldBe` [ b, Row EmptyLine EmptyLine, a ]
+        \ (a, b) -> adjoinRowsBy (pure openMaybe) [ Row EmptyLine EmptyLine, a ] b `shouldBe` [ b, Row EmptyLine EmptyLine, a ]
 
     prop "promotes elements through empty lines onto open lines" $
       forAll ((arbitrary `suchThat` isOpenBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isOpenBy openMaybe)) $
-        \ (a, b) -> adjoinRowsBy openMaybe openMaybe [ Row EmptyLine EmptyLine, a ] b `shouldBe` Row EmptyLine EmptyLine : adjoinRowsBy openMaybe openMaybe [ a ] b
+        \ (a, b) -> adjoinRowsBy (pure openMaybe) [ Row EmptyLine EmptyLine, a ] b `shouldBe` Row EmptyLine EmptyLine : adjoinRowsBy (pure openMaybe) [ a ] b
 
   describe "splitTermByLines" $ do
     prop "preserves line count" $