From ef038150dbe540f7aed8adb41324d2832256e8c0 Mon Sep 17 00:00:00 2001 From: joshvera Date: Mon, 7 Dec 2015 21:53:51 -0500 Subject: [PATCH 01/79] docs --- src/Split.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Split.hs b/src/Split.hs index 8af355b0b..0cff0ae3f 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -94,6 +94,8 @@ instance Monoid Line where mempty = Line [] mappend (Line xs) (Line ys) = Line (xs <> ys) +-- | Takes a term and a `source` and returns a list of HTML lines +-- | and their range within `source`. termToLines :: Term a Info -> String -> ([Line], Range) termToLines (Info range _ categories :< syntax) source = (rows syntax, range) where From e9975fea2bd676397cb1ebe3751d0cb810c2a18f Mon Sep 17 00:00:00 2001 From: joshvera Date: Tue, 8 Dec 2015 12:08:19 -0500 Subject: [PATCH 02/79] Change Row constructor to be Row Line Line --- src/Split.hs | 65 +++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 46 insertions(+), 19 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 0cff0ae3f..95f431013 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -56,17 +56,31 @@ split diff before after = return . renderHtml . (table ! A.class_ (stringValue "diff")) . mconcat $ toMarkup <$> (fst $ diffToRows diff (0, 0) before after) -data Row = Row [HTML] [HTML] +data Row = Row Line Line deriving (Show, Eq) instance ToMarkup Row where - toMarkup (Row left right) = (tr $ (td . mconcat $ toMarkup <$> left) <> (td . mconcat $ toMarkup <$> right)) + toMarkup (Row left right) = (tr $ toMarkup left <> toMarkup right) + +instance ToMarkup Line where + toMarkup (Line html) = td . mconcat $ toMarkup <$> html + +data Line = Line { unLine :: [HTML] } | EmptyLine deriving (Show, Eq) + +instance Monoid Line where + mempty = EmptyLine + mappend EmptyLine EmptyLine = EmptyLine + mappend EmptyLine (Line ys) = Line ys + mappend (Line xs) EmptyLine = Line xs + mappend (Line xs) (Line ys) = Line (xs <> ys) bimap :: ([HTML] -> [HTML]) -> ([HTML] -> [HTML]) -> Row -> Row -bimap f g (Row a b) = Row (f a) (g b) +bimap f g (Row (Line a) (Line b)) = Row (Line $ f a) (Line $ g b) +bimap f g (Row EmptyLine (Line b)) = Row EmptyLine (Line $ g b) +bimap f g (Row (Line a) EmptyLine) = Row (Line $ f a) EmptyLine instance Monoid Row where - mempty = Row [] [] + mempty = Row EmptyLine EmptyLine mappend (Row x1 y1) (Row x2 y2) = Row (x1 <> x2) (y1 <> y2) diffToRows :: Diff a Info -> (Int, Int) -> String -> String -> ([Row], (Range, Range)) @@ -74,26 +88,20 @@ diffToRows (Free annotated) _ before after = annotatedToRows annotated before af diffToRows (Pure (Insert term)) (previousIndex, _) _ after = (rowWithInsertedLine <$> afterLines, (range, Range previousIndex previousIndex)) where (afterLines, range) = termToLines term after - rowWithInsertedLine (Line elements) = Row [] [ Div (Just "insert") elements ] + rowWithInsertedLine (Line elements) = Row EmptyLine $ Line [ Div (Just "insert") elements ] diffToRows (Pure (Delete term)) (_, previousIndex) before _ = (rowWithDeletedLine <$> lines, (range, Range previousIndex previousIndex)) where (lines, range) = termToLines term before - rowWithDeletedLine (Line elements) = Row [ Div (Just "delete") elements ] [] + rowWithDeletedLine (Line elements) = Row (Line [ Div (Just "delete") elements ]) EmptyLine diffToRows (Pure (Replace a b)) _ before after = (replacedRows, (leftRange, rightRange)) where replacedRows = zipWithMaybe rowFromMaybeRows (replace <$> leftElements) (replace <$> rightElements) replace = (:[]) . Div (Just "replace") . unLine rowFromMaybeRows :: Maybe [HTML] -> Maybe [HTML] -> Row - rowFromMaybeRows a b = Row (join $ Maybe.maybeToList a) (join $ Maybe.maybeToList b) + rowFromMaybeRows a b = Row (Line . join $ Maybe.maybeToList a) (Line . join $ Maybe.maybeToList b) (leftElements, leftRange) = termToLines a before (rightElements, rightRange) = termToLines b after -newtype Line = Line { unLine :: [HTML] } deriving (Show, Eq) - -instance Monoid Line where - mempty = Line [] - mappend (Line xs) (Line ys) = Line (xs <> ys) - -- | Takes a term and a `source` and returns a list of HTML lines -- | and their range within `source`. termToLines :: Term a Info -> String -> ([Line], Range) @@ -147,7 +155,7 @@ ends :: (Range, Range) -> (Int, Int) ends (left, right) = (end left, end right) rowFromMaybeRows :: Maybe HTML -> Maybe HTML -> Row -rowFromMaybeRows a b = Row (Maybe.maybeToList a) (Maybe.maybeToList b) +rowFromMaybeRows a b = Row (Line $ Maybe.maybeToList a) (Line $ Maybe.maybeToList b) -- | Adjoin a list of rows onto an existing list of rows. adjoinRows :: [Row] -> [Row] -> [Row] @@ -157,13 +165,32 @@ adjoinRows accum (row : rows) = reverse (adjoin2 (reverse accum) row) ++ rows adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] -adjoin2 (Row [] [] : init) row = adjoin2 init row -adjoin2 (Row [] rights : Row lefts rights' : init) (Row xs ys) = - Row [] (rights <> ys) : Row (lefts <> xs) rights' : init -adjoin2 (Row lefts [] : Row lefts' rights : init) (Row xs ys) = - Row (lefts <> xs) [] : Row lefts' (rights <> ys) : init +adjoin2 (Row EmptyLine EmptyLine : init) row = adjoin2 init row +adjoin2 (Row EmptyLine rights : Row lefts rights' : init) (Row xs ys) = + Row EmptyLine (rights <> ys) : Row (lefts <> xs) rights' : init +adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) = + Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init adjoin2 (last:init) row = (last <> row) : init +{- +foo.bar([ + quux +]).baz +d() + +foo.bar([ quux ]).baz +d() + +"foo.bar([" "foo.bar([ quux ]).baz" +" quux" [] +"]).baz" [] +"d()" "d()" + +"#include b" "#include b" +"#include ..." [] +"#include a" "#include a" + +-} adjoinLines :: [Line] -> [Line] -> [Line] adjoinLines [] lines = lines adjoinLines lines [] = lines From 5402a2bfbc2ca4725ff1a678661a94ae0e8c1086 Mon Sep 17 00:00:00 2001 From: joshvera Date: Tue, 8 Dec 2015 12:14:36 -0500 Subject: [PATCH 03/79] Add exhaustive cases to some functions --- src/Split.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 95f431013..85b1a9af0 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -63,6 +63,7 @@ instance ToMarkup Row where toMarkup (Row left right) = (tr $ toMarkup left <> toMarkup right) instance ToMarkup Line where + toMarkup EmptyLine = td (string "") toMarkup (Line html) = td . mconcat $ toMarkup <$> html data Line = Line { unLine :: [HTML] } | EmptyLine deriving (Show, Eq) @@ -75,9 +76,10 @@ instance Monoid Line where mappend (Line xs) (Line ys) = Line (xs <> ys) bimap :: ([HTML] -> [HTML]) -> ([HTML] -> [HTML]) -> Row -> Row +bimap _ _ (Row EmptyLine EmptyLine) = mempty bimap f g (Row (Line a) (Line b)) = Row (Line $ f a) (Line $ g b) -bimap f g (Row EmptyLine (Line b)) = Row EmptyLine (Line $ g b) -bimap f g (Row (Line a) EmptyLine) = Row (Line $ f a) EmptyLine +bimap _ g (Row EmptyLine (Line b)) = Row EmptyLine (Line $ g b) +bimap f _ (Row (Line a) EmptyLine) = Row (Line $ f a) EmptyLine instance Monoid Row where mempty = Row EmptyLine EmptyLine @@ -89,10 +91,12 @@ diffToRows (Pure (Insert term)) (previousIndex, _) _ after = (rowWithInsertedLin where (afterLines, range) = termToLines term after rowWithInsertedLine (Line elements) = Row EmptyLine $ Line [ Div (Just "insert") elements ] + rowWithInsertedLine EmptyLine = mempty diffToRows (Pure (Delete term)) (_, previousIndex) before _ = (rowWithDeletedLine <$> lines, (range, Range previousIndex previousIndex)) where (lines, range) = termToLines term before rowWithDeletedLine (Line elements) = Row (Line [ Div (Just "delete") elements ]) EmptyLine + rowWithDeletedLine EmptyLine = mempty diffToRows (Pure (Replace a b)) _ before after = (replacedRows, (leftRange, rightRange)) where replacedRows = zipWithMaybe rowFromMaybeRows (replace <$> leftElements) (replace <$> rightElements) @@ -111,6 +115,7 @@ termToLines (Info range _ categories :< syntax) source = (rows syntax, range) rows (Indexed i) = rewrapLineContentsInUl <$> childLines i rewrapLineContentsInUl (Line elements) = Line [ Ul (classify categories) elements ] + rewrapLineContentsInUl EmptyLine = EmptyLine lineElements r s = Line . (:[]) <$> textElements r s childLines i = appendRemainder $ foldl sumLines ([], start range) i appendRemainder (lines, previous) = adjoinLines lines $ lineElements (Range previous (end range)) source From 51be1f341ab7e7761351067fe70e8bf1c1bb1f6e Mon Sep 17 00:00:00 2001 From: joshvera Date: Tue, 8 Dec 2015 12:35:40 -0500 Subject: [PATCH 04/79] Fix tests --- test/Spec.hs | 46 +++++++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 5c8b75219..43764ac53 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -12,44 +12,44 @@ main :: IO () main = hspec $ do describe "adjoinRows" $ do it "empty lines are the left unit" $ - adjoinRows [ Row [] [] ] [ Row [ Text "a" ] [ Text "b" ] ] `shouldBe` [ Row [ Text "a" ] [ Text "b" ] ] + adjoinRows [ Row EmptyLine EmptyLine ] [ Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] `shouldBe` [ Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] it "empty lines are the left unit for multiple lines" $ - adjoinRows [ Row [] [] ] [ Row [ Text "a" ] [ Text "b" ], Row [ Text "a" ] [ Text "b" ] ] `shouldBe` [ Row [ Text "a" ] [ Text "b" ], Row [ Text "a" ] [ Text "b" ] ] + adjoinRows [ Row EmptyLine EmptyLine ] [ Row (Line [ Text "a" ]) (Line [ Text "b" ]), Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] `shouldBe` [ Row (Line [ Text "a" ]) (Line [ Text "b" ]), Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] it "two single line elements should concatenate into a single line" $ - adjoinRows [ Row [ Text "a" ] [ Text "b" ] ] [ Row [ Text "a" ] [ Text "b" ] ] `shouldBe` [ Row [ Text "a", Text "a" ] [ Text "b", Text "b" ] ] + adjoinRows [ Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] [ Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] `shouldBe` [ Row (Line [ Text "a", Text "a" ]) (Line [ Text "b", Text "b" ]) ] it "single line elements on the left concatenate onto the first of multiple lines on the right" $ - adjoinRows [ Row [ Text "a1" ] [ Text "b1" ] ] [ Row [ Text "a2" ] [ Text "b2" ], Row [ Text "a3" ] [ Text "b3" ] ] `shouldBe` [ Row [ Text "a1", Text "a2" ] [ Text "b1", Text "b2" ], Row [ Text "a3" ] [ Text "b3" ] ] + adjoinRows [ Row (Line [ Text "a1" ]) (Line [ Text "b1" ]) ] [ Row (Line [ Text "a2" ]) (Line [ Text "b2" ]), Row (Line [ Text "a3" ]) (Line [ Text "b3" ]) ] `shouldBe` [ Row (Line [ Text "a1", Text "a2" ]) (Line [ Text "b1", Text "b2" ]), Row (Line [ Text "a3" ]) (Line [ Text "b3" ]) ] it "the last of multiple line elements on the left concatenate onto the first of multiple lines on the right" $ - adjoinRows [ Row [ Text "a1" ] [ Text "b1" ], Row [ Text "a2" ] [ Text "b2" ] ] - [ Row [ Text "a3" ] [ Text "b3" ], Row [ Text "a4" ] [ Text "b4" ] ] + adjoinRows [ Row (Line [ Text "a1" ]) (Line [ Text "b1" ]), Row (Line [ Text "a2" ]) (Line [ Text "b2" ]) ] + [ Row (Line [ Text "a3" ]) (Line [ Text "b3" ]), Row (Line [ Text "a4" ]) (Line [ Text "b4" ]) ] `shouldBe` - [ Row [ Text "a1" ] [ Text "b1" ], - Row [ Text "a2", Text "a3" ] [ Text "b2", Text "b3" ], - Row [ Text "a4" ] [ Text "b4" ] ] + [ Row (Line [ Text "a1" ]) (Line [ Text "b1" ]), + Row (Line [ Text "a2", Text "a3" ]) (Line [ Text "b2", Text "b3" ]), + Row (Line [ Text "a4" ]) (Line [ Text "b4" ]) ] describe "annotatedToRows" $ do it "outputs one row for single-line unchanged leaves" $ - annotatedToRows (unchanged "a" "leaf" (Leaf "")) "a" "a" `shouldBe` ([ Row [ span "a" ] [ span "a" ] ], (Range 0 1, Range 0 1)) + annotatedToRows (unchanged "a" "leaf" (Leaf "")) "a" "a" `shouldBe` ([ Row (Line [ span "a" ]) (Line [ span "a" ]) ], (Range 0 1, Range 0 1)) it "outputs one row for single-line empty unchanged indexed nodes" $ - annotatedToRows (unchanged "[]" "branch" (Indexed [])) "[]" "[]" `shouldBe` ([ Row [ Ul (Just "category-branch") [ Text "[]" ] ] [ Ul (Just "category-branch") [ Text "[]" ] ] ], (Range 0 2, Range 0 2)) + annotatedToRows (unchanged "[]" "branch" (Indexed [])) "[]" "[]" `shouldBe` ([ Row (Line [ Ul (Just "category-branch") [ Text "[]" ] ]) (Line [ Ul (Just "category-branch") [ Text "[]" ] ]) ], (Range 0 2, Range 0 2)) it "outputs one row for single-line non-empty unchanged indexed nodes" $ annotatedToRows (unchanged "[ a, b ]" "branch" (Indexed [ Free . offsetAnnotated 2 2 $ unchanged "a" "leaf" (Leaf ""), Free . offsetAnnotated 5 5 $ unchanged "b" "leaf" (Leaf "") - ])) "[ a, b ]" "[ a, b ]" `shouldBe` ([ Row [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ] [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ] ], (Range 0 8, Range 0 8)) + ])) "[ a, b ]" "[ a, b ]" `shouldBe` ([ Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ]) (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 8)) it "outputs one row for single-line non-empty formatted indexed nodes" $ annotatedToRows (formatted "[ a, b ]" "[ a, b ]" "branch" (Indexed [ Free . offsetAnnotated 2 2 $ unchanged "a" "leaf" (Leaf ""), Free . offsetAnnotated 5 6 $ unchanged "b" "leaf" (Leaf "") - ])) "[ a, b ]" "[ a, b ]" `shouldBe` ([ Row [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ] [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ] ], (Range 0 8, Range 0 9)) + ])) "[ a, b ]" "[ a, b ]" `shouldBe` ([ Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ]) (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 9)) it "outputs two rows for two-line non-empty unchanged indexed nodes" $ annotatedToRows (unchanged "[ a,\nb ]" "branch" (Indexed [ @@ -57,10 +57,10 @@ main = hspec $ do Free . offsetAnnotated 5 5 $ unchanged "b" "leaf" (Leaf "") ])) "[ a,\nb ]" "[ a,\nb ]" `shouldBe` ([ - Row [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ] - [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ], - Row [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ] - [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ] + Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]) + (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]), + Row (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) + (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 8)) it "outputs two rows for two-line non-empty formatted indexed nodes" $ @@ -69,12 +69,12 @@ main = hspec $ do Free . offsetAnnotated 5 5 $ unchanged "b" "leaf" (Leaf "") ])) "[ a,\nb ]" "[\na,\nb ]" `shouldBe` ([ - Row [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ] - [ Ul (Just "category-branch") [ Text "[" ] ], - Row [ Ul (Just "category-branch") [] ] - [ Ul (Just "category-branch") [ Text "", span "a", Text "," ] ], - Row [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ] - [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ] + Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]) + (Line [ Ul (Just "category-branch") [ Text "[" ] ]), + Row EmptyLine + (Line [ Ul (Just "category-branch") [ Text "", span "a", Text "," ] ]), + Row (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) + (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 8)) where From f86f12b7f694e7ac3c76516829e8c7971a8fa313 Mon Sep 17 00:00:00 2001 From: joshvera Date: Tue, 8 Dec 2015 12:35:58 -0500 Subject: [PATCH 05/79] Produce empty lines --- src/Split.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 85b1a9af0..b6821c913 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -13,7 +13,6 @@ import Data.ByteString.Lazy.Internal import Text.Blaze.Html5 import qualified Text.Blaze.Html5.Attributes as A import Text.Blaze.Html.Renderer.Utf8 -import qualified Data.Maybe as Maybe import Data.Monoid import qualified Data.Set as Set @@ -102,7 +101,7 @@ diffToRows (Pure (Replace a b)) _ before after = (replacedRows, (leftRange, righ replacedRows = zipWithMaybe rowFromMaybeRows (replace <$> leftElements) (replace <$> rightElements) replace = (:[]) . Div (Just "replace") . unLine rowFromMaybeRows :: Maybe [HTML] -> Maybe [HTML] -> Row - rowFromMaybeRows a b = Row (Line . join $ Maybe.maybeToList a) (Line . join $ Maybe.maybeToList b) + rowFromMaybeRows a b = Row (maybe EmptyLine Line a) (maybe EmptyLine Line b) (leftElements, leftRange) = termToLines a before (rightElements, rightRange) = termToLines b after @@ -160,7 +159,7 @@ ends :: (Range, Range) -> (Int, Int) ends (left, right) = (end left, end right) rowFromMaybeRows :: Maybe HTML -> Maybe HTML -> Row -rowFromMaybeRows a b = Row (Line $ Maybe.maybeToList a) (Line $ Maybe.maybeToList b) +rowFromMaybeRows a b = Row (maybe EmptyLine (Line . (:[])) a) (maybe EmptyLine (Line . (:[])) b) -- | Adjoin a list of rows onto an existing list of rows. adjoinRows :: [Row] -> [Row] -> [Row] From bcb935c49baa9b203b4a8c41bdba1b1d865a984f Mon Sep 17 00:00:00 2001 From: joshvera Date: Tue, 8 Dec 2015 18:09:45 -0500 Subject: [PATCH 06/79] add maybeFirstNewLine to look in Uls for new lines --- src/Split.hs | 17 +++++++++++++++-- test/Spec.hs | 22 ++++++++++++++++++++++ 2 files changed, 37 insertions(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index b6821c913..92d03d4f1 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -10,7 +10,7 @@ import Control.Comonad.Cofree import Range import Control.Monad.Free import Data.ByteString.Lazy.Internal -import Text.Blaze.Html5 +import Text.Blaze.Html5 hiding (map) import qualified Text.Blaze.Html5.Attributes as A import Text.Blaze.Html.Renderer.Utf8 import Data.Monoid @@ -27,6 +27,15 @@ data HTML = | Dt String deriving (Show, Eq) +maybeFirstNewLine :: HTML -> Maybe HTML +maybeFirstNewLine text@(Text "") = Just text +maybeFirstNewLine text@(Text _) = Nothing +maybeFirstNewLine (Span _ _) = Nothing +maybeFirstNewLine (Dt _) = Nothing +maybeFirstNewLine (Ul _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements +maybeFirstNewLine (Dl _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements +maybeFirstNewLine (Div _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements + classifyMarkup :: Maybe ClassName -> Markup -> Markup classifyMarkup (Just className) element = element ! A.class_ (stringValue className) classifyMarkup _ element = element @@ -172,8 +181,12 @@ adjoin2 [] row = [row] adjoin2 (Row EmptyLine EmptyLine : init) row = adjoin2 init row adjoin2 (Row EmptyLine rights : Row lefts rights' : init) (Row xs ys) = Row EmptyLine (rights <> ys) : Row (lefts <> xs) rights' : init -adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) = +adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs@(Line (node : _)) ys) | Just _ <- maybeFirstNewLine node = Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init +-- adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) = +-- Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init +adjoin2 rows row@(Row (Line (node : _)) _) | Just _ <- maybeFirstNewLine node = row : rows +adjoin2 rows row@(Row _ (Line (node : _))) | Just _ <- maybeFirstNewLine node = row : rows adjoin2 (last:init) row = (last <> row) : init {- diff --git a/test/Spec.hs b/test/Spec.hs index 43764ac53..6af10f5d7 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -77,6 +77,28 @@ main = hspec $ do (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 8)) + it "" $ + let (sourceA, sourceB) = ("[\na\n,\nb]", "[a,b]") in + annotatedToRows (formatted sourceA sourceB "branch" (Indexed [ + Free . offsetAnnotated 2 1 $ unchanged "a" "leaf" (Leaf ""), + Free . offsetAnnotated 7 3 $ unchanged "b" "leaf" (Leaf "") + ])) sourceA sourceB `shouldBe` + ([ + Row (Line [ Ul (Just "category-branch") [ Text "[" ] ]) + (Line [ Ul (Just "category-branch") [ Text "[", span "a", Text ",", span "b", Text "]" ] ]), + Row (Line [ Ul (Just "category-branch") [ Text "", span "a" ] ]) + EmptyLine, + Row (Line [ Ul (Just "category-branch") [ Text "", Text "," ] ]) + EmptyLine, + Row (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) + EmptyLine + ], (Range 0 8, Range 0 5)) + + describe "adjoin2" $ do + it "appends a row starting with a newline" $ + adjoin2 [ Row (Line [ Ul Nothing [ Text "[",Span Nothing "a" ]]) EmptyLine ] (Row (Line [ Text "", Text "," ]) EmptyLine) `shouldBe` + [ Row (Line [ Text "", Text "," ]) EmptyLine, Row (Line [ Ul Nothing [ Text "[",Span Nothing "a" ]]) EmptyLine ] + where info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ]) unchanged source category = formatted source source category From c67ff8f2e5ebabf0f4ce53b8ffa6f8146c3b507a Mon Sep 17 00:00:00 2001 From: joshvera Date: Tue, 8 Dec 2015 19:52:38 -0500 Subject: [PATCH 07/79] working through adjoin2 --- src/Split.hs | 54 +++++++++++++++++++++++++++++++++++++++++++++------- test/Spec.hs | 10 ++++++---- 2 files changed, 53 insertions(+), 11 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 92d03d4f1..8cb41ed97 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -178,18 +178,58 @@ adjoinRows accum (row : rows) = reverse (adjoin2 (reverse accum) row) ++ rows adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] +-- handle the case where we append a newline on both sides +adjoin2 rows (Row left@(Line [ Text "" ]) right) = Row left EmptyLine : zipWith Row lefts rights + where + lefts = leftLines rows + rights = adjoin2Lines (rightLines rows) right +adjoin2 rows (Row left right@(Line [ Text "" ])) = Row EmptyLine right : zipWith Row lefts rights + where + lefts = adjoin2Lines (leftLines rows) left + rights = rightLines rows + adjoin2 (Row EmptyLine EmptyLine : init) row = adjoin2 init row -adjoin2 (Row EmptyLine rights : Row lefts rights' : init) (Row xs ys) = - Row EmptyLine (rights <> ys) : Row (lefts <> xs) rights' : init -adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs@(Line (node : _)) ys) | Just _ <- maybeFirstNewLine node = - Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init + +adjoin2 rows (Row left right) = zipWith Row lefts rights + where + lefts = adjoin2Lines (leftLines rows) left + rights = adjoin2Lines (rightLines rows) right + +-- adjoin2 (Row EmptyLine rights : Row lefts rights' : init) (Row xs ys) = + -- adjoin2 (adjoin2 init row2) row1 + -- where row1 = Row EmptyLine (rights <> ys) + -- row2 = Row + -- Row EmptyLine (rights <> ys) : Row (lefts <> xs) rights' : init +-- adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) = + -- Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init + -- adjoin2 (adjoin2 init row2) row1 + -- where row1 = Row EmptyLine (rights <> ys) + -- row2 = Row lefts' (rights <> ys) + -- adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) = -- Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init -adjoin2 rows row@(Row (Line (node : _)) _) | Just _ <- maybeFirstNewLine node = row : rows -adjoin2 rows row@(Row _ (Line (node : _))) | Just _ <- maybeFirstNewLine node = row : rows -adjoin2 (last:init) row = (last <> row) : init +-- adjoin2 (last:init) row = (last <> row) : init + +leftLines :: [Row] -> [Line] +leftLines rows = left <$> rows + where + left (Row left _) = left + +rightLines :: [Row] -> [Line] +rightLines rows = right <$> rows + where + right (Row _ right) = right + +adjoin2Lines :: [Line] -> Line -> [Line] +adjoin2Lines [] line = [line] +adjoin2Lines (EmptyLine : xs) line = EmptyLine : (adjoin2Lines xs line) +adjoin2Lines (last:init) line = (last <> line) : init + {- + + + foo.bar([ quux ]).baz diff --git a/test/Spec.hs b/test/Spec.hs index 6af10f5d7..0bcf6bad3 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -95,10 +95,12 @@ main = hspec $ do ], (Range 0 8, Range 0 5)) describe "adjoin2" $ do - it "appends a row starting with a newline" $ - adjoin2 [ Row (Line [ Ul Nothing [ Text "[",Span Nothing "a" ]]) EmptyLine ] (Row (Line [ Text "", Text "," ]) EmptyLine) `shouldBe` - [ Row (Line [ Text "", Text "," ]) EmptyLine, Row (Line [ Ul Nothing [ Text "[",Span Nothing "a" ]]) EmptyLine ] - + it "appends a right-hand line without newlines" $ + adjoin2 [ Row EmptyLine (Line [ Text "[" ]) ] (Row EmptyLine (Line [ span "a" ])) `shouldBe` + [ Row EmptyLine (Line [ Text "[", span "a" ]) ] + it "appends onto newlines" $ + adjoin2 [ Row (Line [ Text ""]) EmptyLine ] (Row (Line [ Text "," ]) EmptyLine) `shouldBe` + [ Row (Line [ Text "", Text "," ]) EmptyLine ] where info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ]) unchanged source category = formatted source source category From dc456afc6545cc06e9420646d31b43372a0c01e0 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 11:25:38 -0500 Subject: [PATCH 08/79] add newline to the end of Row toMarkup --- src/Split.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index 8cb41ed97..a60953ad2 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -68,7 +68,7 @@ data Row = Row Line Line deriving (Show, Eq) instance ToMarkup Row where - toMarkup (Row left right) = (tr $ toMarkup left <> toMarkup right) + toMarkup (Row left right) = (tr $ toMarkup left <> toMarkup right) <> string "\n" instance ToMarkup Line where toMarkup EmptyLine = td (string "") From dd54f61206bab01013d0b7e45d4d05363b4d7d80 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 13:30:51 -0500 Subject: [PATCH 09/79] Remove adjoinRows from the equation --- src/Split.hs | 42 ++++++++++++++++++------------------------ 1 file changed, 18 insertions(+), 24 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index a60953ad2..13d1046db 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -150,7 +150,7 @@ annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCatego sumRows (rows, previousIndices) child = (allRows, ends childRanges) where separatorRows = contextRows (starts childRanges) previousIndices sources - allRows = rows `adjoinRows` separatorRows `adjoinRows` childRows + allRows = reverse . foldl adjoin2 [] $ rows ++ separatorRows ++ childRows (childRows, childRanges) = diffToRows child previousIndices before after contextRows :: (Int, Int) -> (Int, Int) -> (String, String) -> [Row] @@ -161,6 +161,18 @@ contextRows childIndices previousIndices sources = zipWithMaybe rowFromMaybeRows textElements range source = Text <$> actualLines (substring range source) +{- + +["", ","] +"a", "" +"," "" +"b" + +"a" +"", "," + +-} + starts :: (Range , Range) -> (Int, Int) starts (left, right) = (start left, start right) @@ -195,21 +207,6 @@ adjoin2 rows (Row left right) = zipWith Row lefts rights lefts = adjoin2Lines (leftLines rows) left rights = adjoin2Lines (rightLines rows) right --- adjoin2 (Row EmptyLine rights : Row lefts rights' : init) (Row xs ys) = - -- adjoin2 (adjoin2 init row2) row1 - -- where row1 = Row EmptyLine (rights <> ys) - -- row2 = Row - -- Row EmptyLine (rights <> ys) : Row (lefts <> xs) rights' : init --- adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) = - -- Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init - -- adjoin2 (adjoin2 init row2) row1 - -- where row1 = Row EmptyLine (rights <> ys) - -- row2 = Row lefts' (rights <> ys) - --- adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) = --- Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init --- adjoin2 (last:init) row = (last <> row) : init - leftLines :: [Row] -> [Line] leftLines rows = left <$> rows where @@ -225,11 +222,12 @@ adjoin2Lines [] line = [line] adjoin2Lines (EmptyLine : xs) line = EmptyLine : (adjoin2Lines xs line) adjoin2Lines (last:init) line = (last <> line) : init +adjoinLines :: [Line] -> [Line] -> [Line] +adjoinLines [] lines = lines +adjoinLines lines [] = lines +adjoinLines accum (line : lines) = init accum ++ [ last accum <> line ] ++ lines + {- - - - - foo.bar([ quux ]).baz @@ -248,10 +246,6 @@ d() "#include a" "#include a" -} -adjoinLines :: [Line] -> [Line] -> [Line] -adjoinLines [] lines = lines -adjoinLines lines [] = lines -adjoinLines accum (line : lines) = init accum ++ [ last accum <> line ] ++ lines zipWithMaybe :: (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c] zipWithMaybe f la lb = take len $ zipWith f la' lb' From 51fb407004bf52c5f8596b63d9114e25ef683490 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 13:41:36 -0500 Subject: [PATCH 10/79] Don't adjoin lines if they start with newlines --- src/Split.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 13d1046db..ae294fa27 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -5,7 +5,7 @@ import Diff import Patch import Term import Syntax -import Control.Monad + import Control.Comonad.Cofree import Range import Control.Monad.Free @@ -150,7 +150,8 @@ annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCatego sumRows (rows, previousIndices) child = (allRows, ends childRanges) where separatorRows = contextRows (starts childRanges) previousIndices sources - allRows = reverse . foldl adjoin2 [] $ rows ++ separatorRows ++ childRows + unajoinedRows = rows ++ separatorRows ++ childRows + allRows = reverse $ foldl adjoin2 [] unajoinedRows (childRows, childRanges) = diffToRows child previousIndices before after contextRows :: (Int, Int) -> (Int, Int) -> (String, String) -> [Row] @@ -191,11 +192,11 @@ adjoinRows accum (row : rows) = reverse (adjoin2 (reverse accum) row) ++ rows adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] -- handle the case where we append a newline on both sides -adjoin2 rows (Row left@(Line [ Text "" ]) right) = Row left EmptyLine : zipWith Row lefts rights +adjoin2 rows (Row left@(Line (Text "" : _)) right) = Row left EmptyLine : zipWith Row lefts rights where lefts = leftLines rows rights = adjoin2Lines (rightLines rows) right -adjoin2 rows (Row left right@(Line [ Text "" ])) = Row EmptyLine right : zipWith Row lefts rights +adjoin2 rows (Row left right@(Line ( Text "" : _))) = Row EmptyLine right : zipWith Row lefts rights where lefts = adjoin2Lines (leftLines rows) left rights = rightLines rows From 888a2bbf8a47a31adc3579aef889145e23d611df Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 14:32:00 -0500 Subject: [PATCH 11/79] Remove all uses of adjoinRows --- src/Split.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index ae294fa27..3b5036cc7 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -146,7 +146,7 @@ annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCatego ranges = (left, right) rows = appendRemainder $ foldl sumRows ([], starts ranges) i sources = (before, after) - appendRemainder (rows, previousIndices) = adjoinRows rows $ contextRows (ends ranges) previousIndices sources + appendRemainder (rows, previousIndices) = reverse $ foldl adjoin2 [] $ rows ++ (contextRows (ends ranges) previousIndices sources) sumRows (rows, previousIndices) child = (allRows, ends childRanges) where separatorRows = contextRows (starts childRanges) previousIndices sources From 2fe4f74b699125bf12a215d4d05d9cf5c4c65d92 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 14:35:18 -0500 Subject: [PATCH 12/79] remove comments --- src/Split.hs | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 3b5036cc7..fba80ace2 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -160,19 +160,9 @@ contextRows childIndices previousIndices sources = zipWithMaybe rowFromMaybeRows leftElements = textElements (Range (fst previousIndices) (fst childIndices)) (fst sources) rightElements = textElements (Range (snd previousIndices) (snd childIndices)) (snd sources) -textElements range source = Text <$> actualLines (substring range source) - -{- - -["", ","] -"a", "" -"," "" -"b" - -"a" -"", "," - --} +textElements :: Range -> String -> [HTML] +textElements range source = Text <$> actualLines s + where s = substring range source starts :: (Range , Range) -> (Int, Int) starts (left, right) = (start left, start right) From 0010bb0c77db1b453829acdda9555b526f6e19df Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 9 Dec 2015 14:47:10 -0500 Subject: [PATCH 13/79] Spacing. --- test/Spec.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/Spec.hs b/test/Spec.hs index 0bcf6bad3..965ac787f 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -98,9 +98,11 @@ main = hspec $ do it "appends a right-hand line without newlines" $ adjoin2 [ Row EmptyLine (Line [ Text "[" ]) ] (Row EmptyLine (Line [ span "a" ])) `shouldBe` [ Row EmptyLine (Line [ Text "[", span "a" ]) ] + it "appends onto newlines" $ adjoin2 [ Row (Line [ Text ""]) EmptyLine ] (Row (Line [ Text "," ]) EmptyLine) `shouldBe` [ Row (Line [ Text "", Text "," ]) EmptyLine ] + where info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ]) unchanged source category = formatted source source category From d527a03ca3b2f04febb4c4ddc0fa4f6b722a1b34 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 9 Dec 2015 14:50:57 -0500 Subject: [PATCH 14/79] Test that adjoining newlines does not append. --- test/Spec.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/Spec.hs b/test/Spec.hs index 965ac787f..9f73fc2f3 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -103,6 +103,10 @@ main = hspec $ do adjoin2 [ Row (Line [ Text ""]) EmptyLine ] (Row (Line [ Text "," ]) EmptyLine) `shouldBe` [ Row (Line [ Text "", Text "," ]) EmptyLine ] + it "produces new rows for newlines" $ + adjoin2 [ Row (Line [ Text "a" ]) EmptyLine ] (Row (Line [ Text "" ]) EmptyLine) `shouldBe` + [ Row (Line [ Text "" ]) EmptyLine, Row (Line [ Text "a" ]) EmptyLine ] + where info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ]) unchanged source category = formatted source source category From b97b989803af3397d158c9f7e7d1da1c7065e96c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 9 Dec 2015 14:56:15 -0500 Subject: [PATCH 15/79] Add a newLine definition. --- test/Spec.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/test/Spec.hs b/test/Spec.hs index 9f73fc2f3..3440a5599 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -108,6 +108,7 @@ main = hspec $ do [ Row (Line [ Text "" ]) EmptyLine, Row (Line [ Text "a" ]) EmptyLine ] where + newLine = Line [ Text "" ] info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ]) unchanged source category = formatted source source category formatted source1 source2 category = Annotated (info source1 category, info source2 category) From 6dc5a65ae897fdf475f18cdae259eba89fb5cea4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 9 Dec 2015 14:56:26 -0500 Subject: [PATCH 16/79] Use the newLine definition a bit. --- test/Spec.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 3440a5599..26f68c56a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -100,13 +100,13 @@ main = hspec $ do [ Row EmptyLine (Line [ Text "[", span "a" ]) ] it "appends onto newlines" $ - adjoin2 [ Row (Line [ Text ""]) EmptyLine ] (Row (Line [ Text "," ]) EmptyLine) `shouldBe` + adjoin2 [ Row newLine EmptyLine ] (Row (Line [ Text "," ]) EmptyLine) `shouldBe` [ Row (Line [ Text "", Text "," ]) EmptyLine ] it "produces new rows for newlines" $ - adjoin2 [ Row (Line [ Text "a" ]) EmptyLine ] (Row (Line [ Text "" ]) EmptyLine) `shouldBe` - [ Row (Line [ Text "" ]) EmptyLine, Row (Line [ Text "a" ]) EmptyLine ] - + adjoin2 [ Row (Line [ Text "a" ]) EmptyLine ] (Row newLine EmptyLine) `shouldBe` + [ Row newLine EmptyLine, Row (Line [ Text "a" ]) EmptyLine ] + where newLine = Line [ Text "" ] info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ]) From 4585545eab2fa92b2a5de62400a75ab3569c4a0d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 9 Dec 2015 14:56:33 -0500 Subject: [PATCH 17/79] =?UTF-8?q?Test=20that=20we=20don=E2=80=99t=20promot?= =?UTF-8?q?e=20newlines=20through=20empty=20lines.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- test/Spec.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/Spec.hs b/test/Spec.hs index 26f68c56a..49e63cd83 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -107,6 +107,10 @@ main = hspec $ do adjoin2 [ Row (Line [ Text "a" ]) EmptyLine ] (Row newLine EmptyLine) `shouldBe` [ Row newLine EmptyLine, Row (Line [ Text "a" ]) EmptyLine ] + it "does not promote newlines through empty lines" $ + adjoin2 [ Row EmptyLine (Line [ Text "c" ]), Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] (Row newLine EmptyLine) `shouldBe` + [ Row newLine EmptyLine, Row EmptyLine (Line [ Text "c" ]), Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] + where newLine = Line [ Text "" ] info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ]) From 6f53ed41cf48b57dacb67494c9b7432322caf1f7 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 9 Dec 2015 15:07:30 -0500 Subject: [PATCH 18/79] Sp. --- src/Split.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index fba80ace2..e25386960 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -150,8 +150,8 @@ annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCatego sumRows (rows, previousIndices) child = (allRows, ends childRanges) where separatorRows = contextRows (starts childRanges) previousIndices sources - unajoinedRows = rows ++ separatorRows ++ childRows - allRows = reverse $ foldl adjoin2 [] unajoinedRows + unadjoinedRows = rows ++ separatorRows ++ childRows + allRows = reverse $ foldl adjoin2 [] unadjoinedRows (childRows, childRanges) = diffToRows child previousIndices before after contextRows :: (Int, Int) -> (Int, Int) -> (String, String) -> [Row] From 940be432448fa3a8378da1ba3ba49eaa0bf4933c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 9 Dec 2015 15:22:29 -0500 Subject: [PATCH 19/79] Show instances which make it easier to tell where rows start and end. --- src/Split.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index e25386960..d4678fdcf 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -65,7 +65,10 @@ split diff before after = return . renderHtml . mconcat $ toMarkup <$> (fst $ diffToRows diff (0, 0) before after) data Row = Row Line Line - deriving (Show, Eq) + deriving Eq + +instance Show Row where + show (Row left right) = "\n" ++ show left ++ " | " ++ show right instance ToMarkup Row where toMarkup (Row left right) = (tr $ toMarkup left <> toMarkup right) <> string "\n" @@ -74,7 +77,11 @@ instance ToMarkup Line where toMarkup EmptyLine = td (string "") toMarkup (Line html) = td . mconcat $ toMarkup <$> html -data Line = Line { unLine :: [HTML] } | EmptyLine deriving (Show, Eq) +data Line = Line { unLine :: [HTML] } | EmptyLine deriving Eq + +instance Show Line where + show (Line elements) = "[" ++ (concat $ show <$> elements) ++ "]" + show EmptyLine = "EmptyLine" instance Monoid Line where mempty = EmptyLine From 99bc580df2089a36d06fc6df59521170539566fb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 9 Dec 2015 15:28:42 -0500 Subject: [PATCH 20/79] Correct a fixture. --- test/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index 49e63cd83..e48b43f8e 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -90,7 +90,7 @@ main = hspec $ do EmptyLine, Row (Line [ Ul (Just "category-branch") [ Text "", Text "," ] ]) EmptyLine, - Row (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) + Row (Line [ Ul (Just "category-branch") [ Text "", span "b", Text "]" ] ]) EmptyLine ], (Range 0 8, Range 0 5)) From 5a252911a264d3c5c793f4f397cdd41c79e46f45 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 15:54:31 -0500 Subject: [PATCH 21/79] Fix incorrect index in test --- test/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index e48b43f8e..01348e0df 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -81,7 +81,7 @@ main = hspec $ do let (sourceA, sourceB) = ("[\na\n,\nb]", "[a,b]") in annotatedToRows (formatted sourceA sourceB "branch" (Indexed [ Free . offsetAnnotated 2 1 $ unchanged "a" "leaf" (Leaf ""), - Free . offsetAnnotated 7 3 $ unchanged "b" "leaf" (Leaf "") + Free . offsetAnnotated 6 3 $ unchanged "b" "leaf" (Leaf "") ])) sourceA sourceB `shouldBe` ([ Row (Line [ Ul (Just "category-branch") [ Text "[" ] ]) From d98e8f08011dcfd152147a83103b62c8b1a01060 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 16:52:06 -0500 Subject: [PATCH 22/79] don't append if both sides start with newlines --- src/Split.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Split.hs b/src/Split.hs index d4678fdcf..c945d155a 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -189,6 +189,10 @@ adjoinRows accum (row : rows) = reverse (adjoin2 (reverse accum) row) ++ rows adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] -- handle the case where we append a newline on both sides +adjoin2 rows (Row left@(Line (Text "" : _)) right@(Line (Text "" : _))) = Row left right : zipWith Row lefts rights + where + lefts = leftLines rows + rights = rightLines rows adjoin2 rows (Row left@(Line (Text "" : _)) right) = Row left EmptyLine : zipWith Row lefts rights where lefts = leftLines rows From 088139ed279a7c7c3ef1c2b9c2a47f9b783b000f Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 16:55:26 -0500 Subject: [PATCH 23/79] Delete comments --- src/Split.hs | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index c945d155a..e3aeeceec 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -229,26 +229,6 @@ adjoinLines [] lines = lines adjoinLines lines [] = lines adjoinLines accum (line : lines) = init accum ++ [ last accum <> line ] ++ lines -{- -foo.bar([ - quux -]).baz -d() - -foo.bar([ quux ]).baz -d() - -"foo.bar([" "foo.bar([ quux ]).baz" -" quux" [] -"]).baz" [] -"d()" "d()" - -"#include b" "#include b" -"#include ..." [] -"#include a" "#include a" - --} - zipWithMaybe :: (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c] zipWithMaybe f la lb = take len $ zipWith f la' lb' where From 72a00b0a15fa71a17e448fcc1ad0f32c7a5a970f Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 16:59:40 -0500 Subject: [PATCH 24/79] Remove adjoinRows --- src/Split.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index e3aeeceec..5703c3c48 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -180,12 +180,6 @@ ends (left, right) = (end left, end right) rowFromMaybeRows :: Maybe HTML -> Maybe HTML -> Row rowFromMaybeRows a b = Row (maybe EmptyLine (Line . (:[])) a) (maybe EmptyLine (Line . (:[])) b) --- | Adjoin a list of rows onto an existing list of rows. -adjoinRows :: [Row] -> [Row] -> [Row] -adjoinRows [] rows = rows -adjoinRows rows [] = rows -adjoinRows accum (row : rows) = reverse (adjoin2 (reverse accum) row) ++ rows - adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] -- handle the case where we append a newline on both sides From f3381509b70f9b31cf53acb948df3154a35cbb48 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 17:29:11 -0500 Subject: [PATCH 25/79] remove adjoinRows tests --- test/Spec.hs | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 01348e0df..083815453 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -10,28 +10,6 @@ import Test.Hspec main :: IO () main = hspec $ do - describe "adjoinRows" $ do - it "empty lines are the left unit" $ - adjoinRows [ Row EmptyLine EmptyLine ] [ Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] `shouldBe` [ Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] - - it "empty lines are the left unit for multiple lines" $ - adjoinRows [ Row EmptyLine EmptyLine ] [ Row (Line [ Text "a" ]) (Line [ Text "b" ]), Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] `shouldBe` [ Row (Line [ Text "a" ]) (Line [ Text "b" ]), Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] - - it "two single line elements should concatenate into a single line" $ - adjoinRows [ Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] [ Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] `shouldBe` [ Row (Line [ Text "a", Text "a" ]) (Line [ Text "b", Text "b" ]) ] - - it "single line elements on the left concatenate onto the first of multiple lines on the right" $ - adjoinRows [ Row (Line [ Text "a1" ]) (Line [ Text "b1" ]) ] [ Row (Line [ Text "a2" ]) (Line [ Text "b2" ]), Row (Line [ Text "a3" ]) (Line [ Text "b3" ]) ] `shouldBe` [ Row (Line [ Text "a1", Text "a2" ]) (Line [ Text "b1", Text "b2" ]), Row (Line [ Text "a3" ]) (Line [ Text "b3" ]) ] - - it "the last of multiple line elements on the left concatenate onto the first of multiple lines on the right" $ - adjoinRows [ Row (Line [ Text "a1" ]) (Line [ Text "b1" ]), Row (Line [ Text "a2" ]) (Line [ Text "b2" ]) ] - [ Row (Line [ Text "a3" ]) (Line [ Text "b3" ]), Row (Line [ Text "a4" ]) (Line [ Text "b4" ]) ] - `shouldBe` - [ Row (Line [ Text "a1" ]) (Line [ Text "b1" ]), - Row (Line [ Text "a2", Text "a3" ]) (Line [ Text "b2", Text "b3" ]), - Row (Line [ Text "a4" ]) (Line [ Text "b4" ]) ] - - describe "annotatedToRows" $ do it "outputs one row for single-line unchanged leaves" $ annotatedToRows (unchanged "a" "leaf" (Leaf "")) "a" "a" `shouldBe` ([ Row (Line [ span "a" ]) (Line [ span "a" ]) ], (Range 0 1, Range 0 1)) From a05f03dd921de52856d6f7574687f40dfb85282f Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 17:29:25 -0500 Subject: [PATCH 26/79] add some test combinators --- test/Spec.hs | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 083815453..d3eadc4ff 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -74,23 +74,27 @@ main = hspec $ do describe "adjoin2" $ do it "appends a right-hand line without newlines" $ - adjoin2 [ Row EmptyLine (Line [ Text "[" ]) ] (Row EmptyLine (Line [ span "a" ])) `shouldBe` - [ Row EmptyLine (Line [ Text "[", span "a" ]) ] + adjoin2 [ rightRowText "[" ] (rightRowText "a") `shouldBe` [ rightRow [ Text "[", Text "a" ] ] it "appends onto newlines" $ - adjoin2 [ Row newLine EmptyLine ] (Row (Line [ Text "," ]) EmptyLine) `shouldBe` - [ Row (Line [ Text "", Text "," ]) EmptyLine ] + adjoin2 [ leftRow [ newline ] ] (leftRowText ",") `shouldBe` + [ leftRow [ newline, Text "," ] ] it "produces new rows for newlines" $ - adjoin2 [ Row (Line [ Text "a" ]) EmptyLine ] (Row newLine EmptyLine) `shouldBe` - [ Row newLine EmptyLine, Row (Line [ Text "a" ]) EmptyLine ] + adjoin2 [ leftRowText "a" ] (leftRow [ newline ]) `shouldBe` + [ leftRow [ newline ], leftRowText "a" ] it "does not promote newlines through empty lines" $ - adjoin2 [ Row EmptyLine (Line [ Text "c" ]), Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] (Row newLine EmptyLine) `shouldBe` - [ Row newLine EmptyLine, Row EmptyLine (Line [ Text "c" ]), Row (Line [ Text "a" ]) (Line [ Text "b" ]) ] + adjoin2 [ rightRowText "c", rowText "a" "b" ] (leftRow [ newline ]) `shouldBe` + [ leftRow [ newline ], rightRowText "c", rowText "a" "b" ] where - newLine = Line [ Text "" ] + rightRowText text = rightRow [ Text text ] + rightRow xs = Row EmptyLine (Line xs) + leftRowText text = leftRow [ Text text ] + leftRow xs = Row (Line xs) EmptyLine + rowText a b = Row (Line [ Text a ]) (Line [ Text b ]) + newline = Text "" info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ]) unchanged source category = formatted source source category formatted source1 source2 category = Annotated (info source1 category, info source2 category) From eecfd4ff6d4b71447c7fa673e9853841b2c25f48 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 17:38:40 -0500 Subject: [PATCH 27/79] promotes HTML through empty lines --- test/Spec.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/Spec.hs b/test/Spec.hs index d3eadc4ff..fa96605c2 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -84,6 +84,10 @@ main = hspec $ do adjoin2 [ leftRowText "a" ] (leftRow [ newline ]) `shouldBe` [ leftRow [ newline ], leftRowText "a" ] + it "promotes HTML through empty lines" $ + adjoin2 [ rightRowText "b", leftRow [ newline ] ] (leftRowText "a") `shouldBe` + [ rightRowText "b", leftRow [ newline, Text "a" ] ] + it "does not promote newlines through empty lines" $ adjoin2 [ rightRowText "c", rowText "a" "b" ] (leftRow [ newline ]) `shouldBe` [ leftRow [ newline ], rightRowText "c", rowText "a" "b" ] From 40cc463a9007ed7fb1f00bc4f592cb36b25333d7 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 17:40:41 -0500 Subject: [PATCH 28/79] simplify appending a row with two newlines --- src/Split.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 5703c3c48..4614e7428 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -183,10 +183,7 @@ rowFromMaybeRows a b = Row (maybe EmptyLine (Line . (:[])) a) (maybe EmptyLine adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] -- handle the case where we append a newline on both sides -adjoin2 rows (Row left@(Line (Text "" : _)) right@(Line (Text "" : _))) = Row left right : zipWith Row lefts rights - where - lefts = leftLines rows - rights = rightLines rows +adjoin2 rows (Row left@(Line (Text "" : _)) right@(Line (Text "" : _))) = Row left right : rows adjoin2 rows (Row left@(Line (Text "" : _)) right) = Row left EmptyLine : zipWith Row lefts rights where lefts = leftLines rows From 79d8924b58e5de40db6f07eb050d6514ff96cc56 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 18:50:31 -0500 Subject: [PATCH 29/79] Remove maybeFirstNewLine --- src/Split.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 4614e7428..d2e86558e 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -27,15 +27,6 @@ data HTML = | Dt String deriving (Show, Eq) -maybeFirstNewLine :: HTML -> Maybe HTML -maybeFirstNewLine text@(Text "") = Just text -maybeFirstNewLine text@(Text _) = Nothing -maybeFirstNewLine (Span _ _) = Nothing -maybeFirstNewLine (Dt _) = Nothing -maybeFirstNewLine (Ul _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements -maybeFirstNewLine (Dl _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements -maybeFirstNewLine (Div _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements - classifyMarkup :: Maybe ClassName -> Markup -> Markup classifyMarkup (Just className) element = element ! A.class_ (stringValue className) classifyMarkup _ element = element From 9039068a5c273dcab4b6b74331472c1b107bc87c Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 9 Dec 2015 19:06:29 -0500 Subject: [PATCH 30/79] intersperse commas in Show Line instance --- src/Split.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index d2e86558e..e4e746f35 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -15,6 +15,8 @@ import qualified Text.Blaze.Html5.Attributes as A import Text.Blaze.Html.Renderer.Utf8 import Data.Monoid import qualified Data.Set as Set +import Debug.Trace +import Data.List (intersperse) type ClassName = String @@ -71,7 +73,7 @@ instance ToMarkup Line where data Line = Line { unLine :: [HTML] } | EmptyLine deriving Eq instance Show Line where - show (Line elements) = "[" ++ (concat $ show <$> elements) ++ "]" + show (Line elements) = "[" ++ (concat . intersperse ", " $ show <$> elements) ++ "]" show EmptyLine = "EmptyLine" instance Monoid Line where From 18c95e0b87bd72c21a9efb01a8f243a0cf9f93d0 Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 10 Dec 2015 10:53:47 -0500 Subject: [PATCH 31/79] Fix inserted ranges returned from diffToRows --- src/Split.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index e4e746f35..15849de0d 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -95,7 +95,7 @@ instance Monoid Row where diffToRows :: Diff a Info -> (Int, Int) -> String -> String -> ([Row], (Range, Range)) diffToRows (Free annotated) _ before after = annotatedToRows annotated before after -diffToRows (Pure (Insert term)) (previousIndex, _) _ after = (rowWithInsertedLine <$> afterLines, (range, Range previousIndex previousIndex)) +diffToRows (Pure (Insert term)) (previousIndex, _) _ after = (rowWithInsertedLine <$> afterLines, (Range previousIndex previousIndex, range)) where (afterLines, range) = termToLines term after rowWithInsertedLine (Line elements) = Row EmptyLine $ Line [ Div (Just "insert") elements ] From e86b43380f42d19cb6cf4ccc1bfb70ced04dc304 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 10:09:17 -0500 Subject: [PATCH 32/79] Add a rewrap function. --- src/Split.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Split.hs b/src/Split.hs index 15849de0d..fd72b3e0b 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -143,6 +143,8 @@ annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCatego annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) (Indexed i)) before after = (bimap ((:[]) . Ul (classify leftCategories)) ((:[]) . Ul (classify rightCategories)) <$> rows, ranges) where + rewrap EmptyRow = EmptyRow + rewrap (Row left right) = Row (Line [ Ul (classify leftCategories) $ unLine left ]) (Line [ Ul (classify rightCategories) $ unLine right ]) ranges = (left, right) rows = appendRemainder $ foldl sumRows ([], starts ranges) i sources = (before, after) From 84a817b6bf7b90a8ce137bd2da92c79c26d0945c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 10:09:36 -0500 Subject: [PATCH 33/79] Rewrap the rows in uls. --- src/Split.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index fd72b3e0b..f5707d00e 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -141,7 +141,7 @@ annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCatego leftElements = Span (classify leftCategories) <$> actualLines (substring left before) rightElements = Span (classify rightCategories) <$> actualLines (substring right after) -annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) (Indexed i)) before after = (bimap ((:[]) . Ul (classify leftCategories)) ((:[]) . Ul (classify rightCategories)) <$> rows, ranges) +annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) (Indexed i)) before after = (rewrap <$> rows, ranges) where rewrap EmptyRow = EmptyRow rewrap (Row left right) = Row (Line [ Ul (classify leftCategories) $ unLine left ]) (Line [ Ul (classify rightCategories) $ unLine right ]) From 641ba9b7b7df30002797ceaccd14b6b647fc705a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 10:10:06 -0500 Subject: [PATCH 34/79] :fire: bimap. --- src/Split.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index f5707d00e..4918f6e42 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -83,12 +83,6 @@ instance Monoid Line where mappend (Line xs) EmptyLine = Line xs mappend (Line xs) (Line ys) = Line (xs <> ys) -bimap :: ([HTML] -> [HTML]) -> ([HTML] -> [HTML]) -> Row -> Row -bimap _ _ (Row EmptyLine EmptyLine) = mempty -bimap f g (Row (Line a) (Line b)) = Row (Line $ f a) (Line $ g b) -bimap _ g (Row EmptyLine (Line b)) = Row EmptyLine (Line $ g b) -bimap f _ (Row (Line a) EmptyLine) = Row (Line $ f a) EmptyLine - instance Monoid Row where mempty = Row EmptyLine EmptyLine mappend (Row x1 y1) (Row x2 y2) = Row (x1 <> x2) (y1 <> y2) From b5f9536bcb582a47d7d32a241bc342628a562c9f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 09:29:39 -0500 Subject: [PATCH 35/79] Split up the definition of Line. --- src/Split.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index 4918f6e42..6eca4dbc5 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -70,7 +70,10 @@ instance ToMarkup Line where toMarkup EmptyLine = td (string "") toMarkup (Line html) = td . mconcat $ toMarkup <$> html -data Line = Line { unLine :: [HTML] } | EmptyLine deriving Eq +data Line = + Line { unLine :: [HTML] } + | EmptyLine + deriving Eq instance Show Line where show (Line elements) = "[" ++ (concat . intersperse ", " $ show <$> elements) ++ "]" From da2c1505f32d378e94252cd55d8ad72ccf199105 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 09:46:47 -0500 Subject: [PATCH 36/79] Provide a total definition of unLine. Fixes #304. --- src/Split.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index 6eca4dbc5..d7ac2b77b 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -71,10 +71,14 @@ instance ToMarkup Line where toMarkup (Line html) = td . mconcat $ toMarkup <$> html data Line = - Line { unLine :: [HTML] } + Line [HTML] | EmptyLine deriving Eq +unLine :: Line -> [HTML] +unLine EmptyLine = [] +unLine (Line htmls) = htmls + instance Show Line where show (Line elements) = "[" ++ (concat . intersperse ", " $ show <$> elements) ++ "]" show EmptyLine = "EmptyLine" From 5c9f2762dd74e0ae3a92eaed2fa9f12b76207dcd Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 10 Dec 2015 10:59:46 -0500 Subject: [PATCH 37/79] Remove EmptyRow case --- src/Split.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index d7ac2b77b..5ced466b9 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -144,7 +144,6 @@ annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCatego annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) (Indexed i)) before after = (rewrap <$> rows, ranges) where - rewrap EmptyRow = EmptyRow rewrap (Row left right) = Row (Line [ Ul (classify leftCategories) $ unLine left ]) (Line [ Ul (classify rightCategories) $ unLine right ]) ranges = (left, right) rows = appendRemainder $ foldl sumRows ([], starts ranges) i From a0253de5bfe0887ff302ce371c43c957977ab3de Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 11:06:04 -0500 Subject: [PATCH 38/79] =?UTF-8?q?Don=E2=80=99t=20wrap=20the=20contents=20o?= =?UTF-8?q?f=20empty=20lines.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Split.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index 5ced466b9..0754dd6d0 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -144,7 +144,9 @@ annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCatego annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) (Indexed i)) before after = (rewrap <$> rows, ranges) where - rewrap (Row left right) = Row (Line [ Ul (classify leftCategories) $ unLine left ]) (Line [ Ul (classify rightCategories) $ unLine right ]) + wrap _ EmptyLine = EmptyLine + wrap f (Line elements) = Line [ f elements ] + rewrap (Row left right) = Row (wrap (Ul $ classify leftCategories) left) (wrap (Ul $ classify rightCategories) right) ranges = (left, right) rows = appendRemainder $ foldl sumRows ([], starts ranges) i sources = (before, after) From 6b590a840f27f8eb8190b687b0daa32f567377f4 Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 10 Dec 2015 11:11:02 -0500 Subject: [PATCH 39/79] Map newlines to Break --- src/Split.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 0754dd6d0..891ec65e0 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -21,7 +21,8 @@ import Data.List (intersperse) type ClassName = String data HTML = - Text String + Break + | Text String | Span (Maybe ClassName) String | Ul (Maybe ClassName) [HTML] | Dl (Maybe ClassName) [HTML] @@ -42,6 +43,7 @@ toDd (Text s) = string s toDd e = dd $ toMarkup e instance ToMarkup HTML where + toMarkup Break = string "" toMarkup (Text s) = string s toMarkup (Span className s) = classifyMarkup className . span $ string s toMarkup (Ul className children) = classifyMarkup className . ul $ mconcat (toLi <$> children) @@ -165,8 +167,10 @@ contextRows childIndices previousIndices sources = zipWithMaybe rowFromMaybeRows rightElements = textElements (Range (snd previousIndices) (snd childIndices)) (snd sources) textElements :: Range -> String -> [HTML] -textElements range source = Text <$> actualLines s +textElements range source = textOrBreak <$> actualLines s where s = substring range source + textOrBreak "" = Break + textOrBreak x = Text x starts :: (Range , Range) -> (Int, Int) starts (left, right) = (start left, start right) From 6426a57d51a3d7211638e496c4ad195f752eb0a3 Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 10 Dec 2015 11:13:16 -0500 Subject: [PATCH 40/79] Use Break in adjoin2 --- src/Split.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 891ec65e0..88705bae2 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -184,12 +184,12 @@ rowFromMaybeRows a b = Row (maybe EmptyLine (Line . (:[])) a) (maybe EmptyLine adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] -- handle the case where we append a newline on both sides -adjoin2 rows (Row left@(Line (Text "" : _)) right@(Line (Text "" : _))) = Row left right : rows -adjoin2 rows (Row left@(Line (Text "" : _)) right) = Row left EmptyLine : zipWith Row lefts rights +adjoin2 rows (Row left@(Line (Break : _)) right@(Line (Break : _))) = Row left right : rows +adjoin2 rows (Row left@(Line (Break : _)) right) = Row left EmptyLine : zipWith Row lefts rights where lefts = leftLines rows rights = adjoin2Lines (rightLines rows) right -adjoin2 rows (Row left right@(Line ( Text "" : _))) = Row EmptyLine right : zipWith Row lefts rights +adjoin2 rows (Row left right@(Line (Break : _))) = Row EmptyLine right : zipWith Row lefts rights where lefts = adjoin2Lines (leftLines rows) left rights = rightLines rows From 5b8908ac8283d09414e21977be58a00632c13c4a Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 10 Dec 2015 11:33:02 -0500 Subject: [PATCH 41/79] Represent newlines distinct from empty strings --- src/Split.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 88705bae2..446bebb21 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -169,7 +169,7 @@ contextRows childIndices previousIndices sources = zipWithMaybe rowFromMaybeRows textElements :: Range -> String -> [HTML] textElements range source = textOrBreak <$> actualLines s where s = substring range source - textOrBreak "" = Break + textOrBreak "\n" = Break textOrBreak x = Text x starts :: (Range , Range) -> (Int, Int) @@ -236,4 +236,6 @@ actualLines "" = [""] actualLines lines = case break (== '\n') lines of (l, lines') -> l : (case lines' of [] -> [] - _:lines' -> actualLines lines') + _:lines' -> (case actualLines lines' of + [] -> ["\n"] + s:rest -> ('\n' : s) : rest)) From 0c9308b6aea64fdddd8cb3dd31d6b17e980b3b4b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 11:35:46 -0500 Subject: [PATCH 42/79] Use Break to represent newlines. --- test/Spec.hs | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index fa96605c2..788e1f73c 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -37,8 +37,8 @@ main = hspec $ do ([ Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]) (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]), - Row (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) - (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) + Row (Line [ Ul (Just "category-branch") [ Break, span "b", Text " ]" ] ]) + (Line [ Ul (Just "category-branch") [ Break, span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 8)) it "outputs two rows for two-line non-empty formatted indexed nodes" $ @@ -50,9 +50,9 @@ main = hspec $ do Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]) (Line [ Ul (Just "category-branch") [ Text "[" ] ]), Row EmptyLine - (Line [ Ul (Just "category-branch") [ Text "", span "a", Text "," ] ]), - Row (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) - (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]) + (Line [ Ul (Just "category-branch") [ Break, span "a", Text "," ] ]), + Row (Line [ Ul (Just "category-branch") [ Break, span "b", Text " ]" ] ]) + (Line [ Ul (Just "category-branch") [ Break, span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 8)) it "" $ @@ -64,11 +64,11 @@ main = hspec $ do ([ Row (Line [ Ul (Just "category-branch") [ Text "[" ] ]) (Line [ Ul (Just "category-branch") [ Text "[", span "a", Text ",", span "b", Text "]" ] ]), - Row (Line [ Ul (Just "category-branch") [ Text "", span "a" ] ]) + Row (Line [ Ul (Just "category-branch") [ Break, span "a" ] ]) EmptyLine, - Row (Line [ Ul (Just "category-branch") [ Text "", Text "," ] ]) + Row (Line [ Ul (Just "category-branch") [ Break, Text "," ] ]) EmptyLine, - Row (Line [ Ul (Just "category-branch") [ Text "", span "b", Text "]" ] ]) + Row (Line [ Ul (Just "category-branch") [ Break, span "b", Text "]" ] ]) EmptyLine ], (Range 0 8, Range 0 5)) @@ -77,20 +77,20 @@ main = hspec $ do adjoin2 [ rightRowText "[" ] (rightRowText "a") `shouldBe` [ rightRow [ Text "[", Text "a" ] ] it "appends onto newlines" $ - adjoin2 [ leftRow [ newline ] ] (leftRowText ",") `shouldBe` - [ leftRow [ newline, Text "," ] ] + adjoin2 [ leftRow [ Break ] ] (leftRowText ",") `shouldBe` + [ leftRow [ Break, Text "," ] ] it "produces new rows for newlines" $ - adjoin2 [ leftRowText "a" ] (leftRow [ newline ]) `shouldBe` - [ leftRow [ newline ], leftRowText "a" ] + adjoin2 [ leftRowText "a" ] (leftRow [ Break ]) `shouldBe` + [ leftRow [ Break ], leftRowText "a" ] it "promotes HTML through empty lines" $ - adjoin2 [ rightRowText "b", leftRow [ newline ] ] (leftRowText "a") `shouldBe` - [ rightRowText "b", leftRow [ newline, Text "a" ] ] + adjoin2 [ rightRowText "b", leftRow [ Break ] ] (leftRowText "a") `shouldBe` + [ rightRowText "b", leftRow [ Break, Text "a" ] ] it "does not promote newlines through empty lines" $ - adjoin2 [ rightRowText "c", rowText "a" "b" ] (leftRow [ newline ]) `shouldBe` - [ leftRow [ newline ], rightRowText "c", rowText "a" "b" ] + adjoin2 [ rightRowText "c", rowText "a" "b" ] (leftRow [ Break ]) `shouldBe` + [ leftRow [ Break ], rightRowText "c", rowText "a" "b" ] where rightRowText text = rightRow [ Text text ] @@ -98,7 +98,6 @@ main = hspec $ do leftRowText text = leftRow [ Text text ] leftRow xs = Row (Line xs) EmptyLine rowText a b = Row (Line [ Text a ]) (Line [ Text b ]) - newline = Text "" info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ]) unchanged source category = formatted source source category formatted source1 source2 category = Annotated (info source1 category, info source2 category) From 7abe07bd1639c59eb6e7469b0e7830aad56dad5c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 13:15:32 -0500 Subject: [PATCH 43/79] actualLines ends lines with their newlines. --- src/Split.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 446bebb21..9125f0880 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -234,8 +234,6 @@ classify = foldr (const . Just . ("category-" ++)) Nothing actualLines :: String -> [String] actualLines "" = [""] actualLines lines = case break (== '\n') lines of - (l, lines') -> l : (case lines' of - [] -> [] - _:lines' -> (case actualLines lines' of - [] -> ["\n"] - s:rest -> ('\n' : s) : rest)) + (l, lines') -> (case lines' of + [] -> [ l ] + _:lines' -> (l ++ "\n") : actualLines lines') From 67ec6f897fa18d3aba4be1166b1e725a751cbaae Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 13:16:42 -0500 Subject: [PATCH 44/79] maybeLast produces the last element of a list, if any. --- src/Split.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Split.hs b/src/Split.hs index 9125f0880..256f24080 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -13,6 +13,7 @@ import Data.ByteString.Lazy.Internal import Text.Blaze.Html5 hiding (map) import qualified Text.Blaze.Html5.Attributes as A import Text.Blaze.Html.Renderer.Utf8 +import Data.Maybe import Data.Monoid import qualified Data.Set as Set import Debug.Trace @@ -181,6 +182,9 @@ ends (left, right) = (end left, end right) rowFromMaybeRows :: Maybe HTML -> Maybe HTML -> Row rowFromMaybeRows a b = Row (maybe EmptyLine (Line . (:[])) a) (maybe EmptyLine (Line . (:[])) b) +maybeLast :: [a] -> Maybe a +maybeLast list = listToMaybe $ reverse list + adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] -- handle the case where we append a newline on both sides From d1018576fd18381095c610f42bc3c194e3fcdcf3 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 13:16:46 -0500 Subject: [PATCH 45/79] Add breaks to the ends of lines. --- src/Split.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 256f24080..7e23b5a37 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -168,10 +168,11 @@ contextRows childIndices previousIndices sources = zipWithMaybe rowFromMaybeRows rightElements = textElements (Range (snd previousIndices) (snd childIndices)) (snd sources) textElements :: Range -> String -> [HTML] -textElements range source = textOrBreak <$> actualLines s +textElements range source = textAndBreak =<< actualLines s where s = substring range source - textOrBreak "\n" = Break - textOrBreak x = Text x + textAndBreak "" = [] + textAndBreak x | '\n' <- last x = [ Text $ init x, Break ] + textAndBreak x = [ Text x ] starts :: (Range , Range) -> (Int, Int) starts (left, right) = (start left, start right) From 72fef55675134871c70e416966c8a0ea2aca34ba Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 13:17:09 -0500 Subject: [PATCH 46/79] Adjoin expects breaks at the end of lines. --- src/Split.hs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 7e23b5a37..38950a13e 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -188,18 +188,18 @@ maybeLast list = listToMaybe $ reverse list adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] --- handle the case where we append a newline on both sides -adjoin2 rows (Row left@(Line (Break : _)) right@(Line (Break : _))) = Row left right : rows -adjoin2 rows (Row left@(Line (Break : _)) right) = Row left EmptyLine : zipWith Row lefts rights - where - lefts = leftLines rows - rights = adjoin2Lines (rightLines rows) right -adjoin2 rows (Row left right@(Line (Break : _))) = Row EmptyLine right : zipWith Row lefts rights - where - lefts = adjoin2Lines (leftLines rows) left - rights = rightLines rows -adjoin2 (Row EmptyLine EmptyLine : init) row = adjoin2 init row +adjoin2 rows@(Row left right:_) row | Just Break <- maybeLast $ unLine left, Just Break <- maybeLast $ unLine right = row : rows + +adjoin2 rows@(Row left _:_) (Row left' right') | Just Break <- maybeLast $ unLine left = Row left' EmptyLine : zipWith Row lefts rights + where lefts = leftLines rows + rights = adjoin2Lines (rightLines rows) right' + +adjoin2 rows@(Row _ right:_) (Row left' right') | Just Break <- maybeLast $ unLine right = Row EmptyLine right' : zipWith Row lefts rights + where lefts = adjoin2Lines (leftLines rows) left' + rights = rightLines rows + +adjoin2 (Row EmptyLine EmptyLine : rows) row = adjoin2 rows row adjoin2 rows (Row left right) = zipWith Row lefts rights where From d57443afd037f51116925adfe04aca9a62a906bd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 13:38:57 -0500 Subject: [PATCH 47/79] Find the most recent open line in a list. --- src/Split.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Split.hs b/src/Split.hs index 38950a13e..9272ebde3 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -216,6 +216,14 @@ rightLines rows = right <$> rows where right (Row _ right) = right +openLine :: [Line] -> Maybe Line +openLine [] = Nothing +openLine (EmptyLine : rest) = openLine rest +openLine (line : _) = case maybeLast $ unLine line of + Just Break -> Nothing + Just _ -> Just line + Nothing -> Nothing + adjoin2Lines :: [Line] -> Line -> [Line] adjoin2Lines [] line = [line] adjoin2Lines (EmptyLine : xs) line = EmptyLine : (adjoin2Lines xs line) From 7f742bc882885c700e48f34fedc06d75704780e4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 13:40:07 -0500 Subject: [PATCH 48/79] Try to only push through empty lines which have open lines above them. --- src/Split.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 9272ebde3..a89e7188a 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -226,8 +226,8 @@ openLine (line : _) = case maybeLast $ unLine line of adjoin2Lines :: [Line] -> Line -> [Line] adjoin2Lines [] line = [line] -adjoin2Lines (EmptyLine : xs) line = EmptyLine : (adjoin2Lines xs line) -adjoin2Lines (last:init) line = (last <> line) : init +adjoin2Lines (EmptyLine : xs) line | Just _ <- openLine xs = EmptyLine : adjoin2Lines xs line +adjoin2Lines (prev:rest) line = (prev <> line) : rest adjoinLines :: [Line] -> [Line] -> [Line] adjoinLines [] lines = lines From ed86b344d5e507ac6460dc12b40a91d450df7e46 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 14:00:02 -0500 Subject: [PATCH 49/79] For debugging render Break to
--- src/Split.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index a89e7188a..509a29e09 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -44,7 +44,7 @@ toDd (Text s) = string s toDd e = dd $ toMarkup e instance ToMarkup HTML where - toMarkup Break = string "" + toMarkup Break = br toMarkup (Text s) = string s toMarkup (Span className s) = classifyMarkup className . span $ string s toMarkup (Ul className children) = classifyMarkup className . ul $ mconcat (toLi <$> children) From e27122a142f25cfd4d7e44173f4883e417392fc8 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 14:01:06 -0500 Subject: [PATCH 50/79] Only adjoin when we have open lines above us. --- src/Split.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 509a29e09..ecd3d884b 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -189,22 +189,21 @@ maybeLast list = listToMaybe $ reverse list adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] -adjoin2 rows@(Row left right:_) row | Just Break <- maybeLast $ unLine left, Just Break <- maybeLast $ unLine right = row : rows - -adjoin2 rows@(Row left _:_) (Row left' right') | Just Break <- maybeLast $ unLine left = Row left' EmptyLine : zipWith Row lefts rights - where lefts = leftLines rows +adjoin2 rows (Row left' right') | Just _ <- openLine $ leftLines rows, Just _ <- openLine $ rightLines rows = zipWith Row lefts rights + where lefts = adjoin2Lines (leftLines rows) left' rights = adjoin2Lines (rightLines rows) right' -adjoin2 rows@(Row _ right:_) (Row left' right') | Just Break <- maybeLast $ unLine right = Row EmptyLine right' : zipWith Row lefts rights +adjoin2 rows (Row left' right') | Just _ <- openLine $ leftLines rows = Row EmptyLine right' : zipWith Row lefts rights where lefts = adjoin2Lines (leftLines rows) left' rights = rightLines rows +adjoin2 rows (Row left' right') | Just _ <- openLine $ rightLines rows = Row left' EmptyLine : zipWith Row lefts rights + where lefts = leftLines rows + rights = adjoin2Lines (rightLines rows) right' + adjoin2 (Row EmptyLine EmptyLine : rows) row = adjoin2 rows row -adjoin2 rows (Row left right) = zipWith Row lefts rights - where - lefts = adjoin2Lines (leftLines rows) left - rights = adjoin2Lines (rightLines rows) right +adjoin2 rows row = row : rows leftLines :: [Row] -> [Line] leftLines rows = left <$> rows From 43a20d00bd735d164614166382bce3519690f383 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 14:17:22 -0500 Subject: [PATCH 51/79] Extract the element/break function. --- src/Split.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Split.hs b/src/Split.hs index ecd3d884b..c483faa0c 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -167,6 +167,11 @@ contextRows childIndices previousIndices sources = zipWithMaybe rowFromMaybeRows leftElements = textElements (Range (fst previousIndices) (fst childIndices)) (fst sources) rightElements = textElements (Range (snd previousIndices) (snd childIndices)) (snd sources) +elementAndBreak :: (String -> HTML) -> String -> [HTML] +elementAndBreak _ "" = [] +elementAndBreak constructor x | '\n' <- last x = [ constructor $ init x, Break ] +elementAndBreak constructor x = [ constructor x ] + textElements :: Range -> String -> [HTML] textElements range source = textAndBreak =<< actualLines s where s = substring range source From 6d2a89b55a928faa37c77c58a04eda60ca079d7f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 14:17:51 -0500 Subject: [PATCH 52/79] textElements calls out to elementAndBreak. --- src/Split.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index c483faa0c..6953f2c9a 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -173,11 +173,8 @@ elementAndBreak constructor x | '\n' <- last x = [ constructor $ init x, Break ] elementAndBreak constructor x = [ constructor x ] textElements :: Range -> String -> [HTML] -textElements range source = textAndBreak =<< actualLines s +textElements range source = (elementAndBreak Text) =<< actualLines s where s = substring range source - textAndBreak "" = [] - textAndBreak x | '\n' <- last x = [ Text $ init x, Break ] - textAndBreak x = [ Text x ] starts :: (Range , Range) -> (Int, Int) starts (left, right) = (start left, start right) From 004bedf46aa1db06db4d9c7b05406b50ff6060ea Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 14:20:34 -0500 Subject: [PATCH 53/79] annotatedToRows produces elements interspersed with breaks. --- src/Split.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 6953f2c9a..fbf38e86c 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -142,8 +142,8 @@ termToLines (Info range _ categories :< syntax) source = (rows syntax, range) annotatedToRows :: Annotated a (Info, Info) (Diff a Info) -> String -> String -> ([Row], (Range, Range)) annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) (Leaf _)) before after = (zipWithMaybe rowFromMaybeRows leftElements rightElements, (left, right)) where - leftElements = Span (classify leftCategories) <$> actualLines (substring left before) - rightElements = Span (classify rightCategories) <$> actualLines (substring right after) + leftElements = (elementAndBreak $ Span (classify leftCategories)) =<< actualLines (substring left before) + rightElements = (elementAndBreak $ Span (classify rightCategories)) =<< actualLines (substring right after) annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) (Indexed i)) before after = (rewrap <$> rows, ranges) where From dbe1db56431d46288eed6b85282c27e09c23c31c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 14:20:47 -0500 Subject: [PATCH 54/79] termToLines produces elements interspersed with breaks. --- src/Split.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index fbf38e86c..238db47ff 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -136,7 +136,7 @@ termToLines (Info range _ categories :< syntax) source = (rows syntax, range) separatorLines = lineElements (Range previous $ start childRange) source allLines = lines `adjoinLines` separatorLines `adjoinLines` childLines (childLines, childRange) = termToLines child source - elements = Span (classify categories) <$> actualLines (substring range source) + elements = (elementAndBreak $ Span (classify categories)) =<< actualLines (substring range source) -- | Given an Annotated and before/after strings, returns a list of `Row`s representing the newline-separated diff. annotatedToRows :: Annotated a (Info, Info) (Diff a Info) -> String -> String -> ([Row], (Range, Range)) From 2b0c9dc4e28d2ad0799f83c95047ec473ead9b89 Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 10 Dec 2015 14:21:50 -0500 Subject: [PATCH 55/79] Fix some of the tests --- test/Spec.hs | 43 ++++++++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 788e1f73c..ec901a8b8 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -35,10 +35,10 @@ main = hspec $ do Free . offsetAnnotated 5 5 $ unchanged "b" "leaf" (Leaf "") ])) "[ a,\nb ]" "[ a,\nb ]" `shouldBe` ([ - Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]) - (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]), - Row (Line [ Ul (Just "category-branch") [ Break, span "b", Text " ]" ] ]) - (Line [ Ul (Just "category-branch") [ Break, span "b", Text " ]" ] ]) + Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ",", Break ] ]) + (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ",", Break] ]), + Row (Line [ Ul (Just "category-branch") [ span "b", Text " ]" ] ]) + (Line [ Ul (Just "category-branch") [ span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 8)) it "outputs two rows for two-line non-empty formatted indexed nodes" $ @@ -47,12 +47,12 @@ main = hspec $ do Free . offsetAnnotated 5 5 $ unchanged "b" "leaf" (Leaf "") ])) "[ a,\nb ]" "[\na,\nb ]" `shouldBe` ([ - Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]) - (Line [ Ul (Just "category-branch") [ Text "[" ] ]), + Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ",", Break ] ]) + (Line [ Ul (Just "category-branch") [ Text "[", Break ] ]), Row EmptyLine - (Line [ Ul (Just "category-branch") [ Break, span "a", Text "," ] ]), - Row (Line [ Ul (Just "category-branch") [ Break, span "b", Text " ]" ] ]) - (Line [ Ul (Just "category-branch") [ Break, span "b", Text " ]" ] ]) + (Line [ Ul (Just "category-branch") [ span "a", Text ",", Break ] ]), + Row (Line [ Ul (Just "category-branch") [ span "b", Text " ]" ] ]) + (Line [ Ul (Just "category-branch") [ span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 8)) it "" $ @@ -62,35 +62,36 @@ main = hspec $ do Free . offsetAnnotated 6 3 $ unchanged "b" "leaf" (Leaf "") ])) sourceA sourceB `shouldBe` ([ - Row (Line [ Ul (Just "category-branch") [ Text "[" ] ]) + Row (Line [ Ul (Just "category-branch") [ Text "[", Break ] ]) (Line [ Ul (Just "category-branch") [ Text "[", span "a", Text ",", span "b", Text "]" ] ]), - Row (Line [ Ul (Just "category-branch") [ Break, span "a" ] ]) + Row (Line [ Ul (Just "category-branch") [ span "a", Break ] ]) EmptyLine, - Row (Line [ Ul (Just "category-branch") [ Break, Text "," ] ]) + Row (Line [ Ul (Just "category-branch") [ Text ",", Break ] ]) EmptyLine, - Row (Line [ Ul (Just "category-branch") [ Break, span "b", Text "]" ] ]) + Row (Line [ Ul (Just "category-branch") [ span "b", Text "]" ] ]) EmptyLine ], (Range 0 8, Range 0 5)) describe "adjoin2" $ do it "appends a right-hand line without newlines" $ - adjoin2 [ rightRowText "[" ] (rightRowText "a") `shouldBe` [ rightRow [ Text "[", Text "a" ] ] + adjoin2 [ rightRowText "[" ] (rightRowText "a") `shouldBe` + [ rightRow [ Text "[", Text "a" ] ] - it "appends onto newlines" $ + it "does not append onto lines ending in breaks" $ adjoin2 [ leftRow [ Break ] ] (leftRowText ",") `shouldBe` - [ leftRow [ Break, Text "," ] ] + [ leftRowText ",", leftRow [ Break ] ] it "produces new rows for newlines" $ adjoin2 [ leftRowText "a" ] (leftRow [ Break ]) `shouldBe` - [ leftRow [ Break ], leftRowText "a" ] + [ leftRow [ Text "a", Break ] ] - it "promotes HTML through empty lines" $ + it "does not promote HTML through empty lines onto complete lines" $ adjoin2 [ rightRowText "b", leftRow [ Break ] ] (leftRowText "a") `shouldBe` - [ rightRowText "b", leftRow [ Break, Text "a" ] ] + [ leftRowText "a", rightRowText "b", leftRow [ Break ] ] - it "does not promote newlines through empty lines" $ + it "promotes breaks through empty lines onto incomplete lines" $ adjoin2 [ rightRowText "c", rowText "a" "b" ] (leftRow [ Break ]) `shouldBe` - [ leftRow [ Break ], rightRowText "c", rowText "a" "b" ] + [ rightRowText "c", Row (Line [ Text "a", Break ]) (Line [ Text "b" ]) ] where rightRowText text = rightRow [ Text text ] From d9e9b73fd7970a556c784bd153539a843473bb51 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 14:25:02 -0500 Subject: [PATCH 56/79] Move the Empty/Empty case up. --- src/Split.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 238db47ff..8e54f9e58 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -191,6 +191,8 @@ maybeLast list = listToMaybe $ reverse list adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] +adjoin2 (Row EmptyLine EmptyLine : rows) row = adjoin2 rows row + adjoin2 rows (Row left' right') | Just _ <- openLine $ leftLines rows, Just _ <- openLine $ rightLines rows = zipWith Row lefts rights where lefts = adjoin2Lines (leftLines rows) left' rights = adjoin2Lines (rightLines rows) right' @@ -203,8 +205,6 @@ adjoin2 rows (Row left' right') | Just _ <- openLine $ rightLines rows = Row lef where lefts = leftLines rows rights = adjoin2Lines (rightLines rows) right' -adjoin2 (Row EmptyLine EmptyLine : rows) row = adjoin2 rows row - adjoin2 rows row = row : rows leftLines :: [Row] -> [Line] From 1b370a059dd1c9d89ef2cc40a6f51f63d59d2578 Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 10 Dec 2015 14:26:49 -0500 Subject: [PATCH 57/79] rename some tests --- test/Spec.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index ec901a8b8..bcff69b60 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -73,15 +73,15 @@ main = hspec $ do ], (Range 0 8, Range 0 5)) describe "adjoin2" $ do - it "appends a right-hand line without newlines" $ + it "appends appends HTML onto incomplete lines" $ adjoin2 [ rightRowText "[" ] (rightRowText "a") `shouldBe` [ rightRow [ Text "[", Text "a" ] ] - it "does not append onto lines ending in breaks" $ + it "does not append HTML onto complete lines" $ adjoin2 [ leftRow [ Break ] ] (leftRowText ",") `shouldBe` [ leftRowText ",", leftRow [ Break ] ] - it "produces new rows for newlines" $ + it "appends breaks onto incomplete lines" $ adjoin2 [ leftRowText "a" ] (leftRow [ Break ]) `shouldBe` [ leftRow [ Text "a", Break ] ] From 14de32f3e94978b71bb79dc0db267cfd5e95f6e8 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 14:34:52 -0500 Subject: [PATCH 58/79] =?UTF-8?q?Don=E2=80=99t=20adjoin=20empty/empty=20ro?= =?UTF-8?q?ws=20onto=20the=20top.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Split.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Split.hs b/src/Split.hs index 8e54f9e58..c642b88ba 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -191,6 +191,8 @@ maybeLast list = listToMaybe $ reverse list adjoin2 :: [Row] -> Row -> [Row] adjoin2 [] row = [row] +adjoin2 rows (Row EmptyLine EmptyLine) = rows + adjoin2 (Row EmptyLine EmptyLine : rows) row = adjoin2 rows row adjoin2 rows (Row left' right') | Just _ <- openLine $ leftLines rows, Just _ <- openLine $ rightLines rows = zipWith Row lefts rights From e4b5c97db2ebc77a281da0a6359519725423650b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 14:35:08 -0500 Subject: [PATCH 59/79] =?UTF-8?q?Don=E2=80=99t=20add=20an=20empty/empty=20?= =?UTF-8?q?row=20when=20one=20side=20or=20the=20other=20is=20closed.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Split.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index c642b88ba..a40daa2ff 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -199,12 +199,18 @@ adjoin2 rows (Row left' right') | Just _ <- openLine $ leftLines rows, Just _ <- where lefts = adjoin2Lines (leftLines rows) left' rights = adjoin2Lines (rightLines rows) right' -adjoin2 rows (Row left' right') | Just _ <- openLine $ leftLines rows = Row EmptyLine right' : zipWith Row lefts rights - where lefts = adjoin2Lines (leftLines rows) left' +adjoin2 rows (Row left' right') | Just _ <- openLine $ leftLines rows = case right' of + EmptyLine -> rest + _ -> Row EmptyLine right' : rest + where rest = zipWith Row lefts rights + lefts = adjoin2Lines (leftLines rows) left' rights = rightLines rows -adjoin2 rows (Row left' right') | Just _ <- openLine $ rightLines rows = Row left' EmptyLine : zipWith Row lefts rights - where lefts = leftLines rows +adjoin2 rows (Row left' right') | Just _ <- openLine $ rightLines rows = case left' of + EmptyLine -> rest + _ -> Row left' EmptyLine : rest + where rest = zipWith Row lefts rights + lefts = leftLines rows rights = adjoin2Lines (rightLines rows) right' adjoin2 rows row = row : rows From 3e8517a2a3b6ca96e7726fbef800d44d09efcc91 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 14:50:08 -0500 Subject: [PATCH 60/79] Full width tables. --- prototype/UI/style.css | 3 +++ 1 file changed, 3 insertions(+) diff --git a/prototype/UI/style.css b/prototype/UI/style.css index c0d290f9d..50cbbaccf 100644 --- a/prototype/UI/style.css +++ b/prototype/UI/style.css @@ -1,3 +1,6 @@ +table { + width: 100%; +} table.diff td { width: 50%; height: 15px; From ed87838de63747321ee04b5cea98b5c4c561fe46 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 15:11:42 -0500 Subject: [PATCH 61/79] Add a trace' function to help trace some bugs. --- src/Split.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Split.hs b/src/Split.hs index a40daa2ff..c1acebcd3 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -52,6 +52,9 @@ instance ToMarkup HTML where toMarkup (Div className children) = classifyMarkup className . div $ mconcat (toMarkup <$> children) toMarkup (Dt key) = dt $ string key +trace' :: Show a => a -> a +trace' a = traceShow a a + split :: Diff a Info -> String -> String -> IO ByteString split diff before after = return . renderHtml . docTypeHtml From 325d6e6a73f48303b8f50ca202a8ed3d60c37b4c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 15:11:56 -0500 Subject: [PATCH 62/79] Add a test of multi-line patches. --- test/Spec.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/test/Spec.hs b/test/Spec.hs index bcff69b60..c8705a8ef 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,9 +1,11 @@ module Main where import Diff +import Patch import Range import Split import Syntax +import Control.Comonad.Cofree import Control.Monad.Free import qualified Data.Set as Set import Test.Hspec @@ -72,6 +74,18 @@ main = hspec $ do EmptyLine ], (Range 0 8, Range 0 5)) + it "should split multi-line deletions across multiple rows" $ + let (sourceA, sourceB) = ("/*\n*/\na", "a") in + annotatedToRows (formatted sourceA sourceB "branch" (Indexed [ + Pure . Delete $ (Info (Range 0 5) (Range 0 2) (Set.fromList ["comment"]) :< (Leaf "")), + Free . offsetAnnotated 6 0 $ unchanged "a" "leaf" (Leaf "") + ])) sourceA sourceB `shouldBe` + ([ + Row (Line [ Ul (Just "category-branch") [ Div (Just "delete") [ span "/*", Break ] ] ]) EmptyLine, + Row (Line [ Ul (Just "category-branch") [ Div (Just "delete") [ span "*/" ], Break ] ]) EmptyLine, + Row (Line [ Ul (Just "category-branch") [ span "a" ] ]) (Line [ Ul (Just "category-branch") [ span "a" ] ]) + ], (Range 0 7, Range 0 1)) + describe "adjoin2" $ do it "appends appends HTML onto incomplete lines" $ adjoin2 [ rightRowText "[" ] (rightRowText "a") `shouldBe` From c2f54ce8d87bbb73f70d28de25cb473549b81f16 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 15:31:53 -0500 Subject: [PATCH 63/79] Determine whether the last in a list of HTML elements is open or not. --- src/Split.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Split.hs b/src/Split.hs index c1acebcd3..29da43981 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -228,6 +228,13 @@ rightLines rows = right <$> rows where right (Row _ right) = right +openElement :: HTML -> Maybe HTML +openElement Break = Nothing +openElement (Ul _ elements) = getLast . mconcat . map Last $ openElement <$> elements +openElement (Dl _ elements) = getLast . mconcat . map Last $ openElement <$> elements +openElement (Div _ elements) = getLast . mconcat . map Last $ openElement <$> elements +openElement h = Just h + openLine :: [Line] -> Maybe Line openLine [] = Nothing openLine (EmptyLine : rest) = openLine rest From 200037b50916cf4ba63172cae5832e03426ce9dd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 15:34:11 -0500 Subject: [PATCH 64/79] Test whether the last element in a Line is open. --- src/Split.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 29da43981..389a735a5 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -8,6 +8,7 @@ import Syntax import Control.Comonad.Cofree import Range +import Control.Monad import Control.Monad.Free import Data.ByteString.Lazy.Internal import Text.Blaze.Html5 hiding (map) @@ -238,10 +239,7 @@ openElement h = Just h openLine :: [Line] -> Maybe Line openLine [] = Nothing openLine (EmptyLine : rest) = openLine rest -openLine (line : _) = case maybeLast $ unLine line of - Just Break -> Nothing - Just _ -> Just line - Nothing -> Nothing +openLine (line : _) = const line <$> (join . maybeLast $ openElement <$> unLine line) adjoin2Lines :: [Line] -> Line -> [Line] adjoin2Lines [] line = [line] From 46bd5bc545c37460af7ae85ea8cf6811c700461d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 15:41:02 -0500 Subject: [PATCH 65/79] Test that termToLines produces complete lines. --- test/Spec.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/test/Spec.hs b/test/Spec.hs index c8705a8ef..a90e4717f 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -107,6 +107,15 @@ main = hspec $ do adjoin2 [ rightRowText "c", rowText "a" "b" ] (leftRow [ Break ]) `shouldBe` [ rightRowText "c", Row (Line [ Text "a", Break ]) (Line [ Text "b" ]) ] + describe "termToLines" $ do + it "splits multi-line terms into multiple lines" $ + termToLines (Info (Range 0 5) (Range 0 2) (Set.fromList ["comment"]) :< (Leaf "")) "/*\n*/" + `shouldBe` + ([ + Line [ span "/*", Break ], + Line [ span "*/" ] + ], Range 0 5) + where rightRowText text = rightRow [ Text text ] rightRow xs = Row EmptyLine (Line xs) From 9619d2fa7f17d41fbbab666aa5a3db15cbc023bf Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 15:47:34 -0500 Subject: [PATCH 66/79] That is not how any of this works. --- test/Spec.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index a90e4717f..199c1e142 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -107,14 +107,14 @@ main = hspec $ do adjoin2 [ rightRowText "c", rowText "a" "b" ] (leftRow [ Break ]) `shouldBe` [ rightRowText "c", Row (Line [ Text "a", Break ]) (Line [ Text "b" ]) ] - describe "termToLines" $ do - it "splits multi-line terms into multiple lines" $ - termToLines (Info (Range 0 5) (Range 0 2) (Set.fromList ["comment"]) :< (Leaf "")) "/*\n*/" - `shouldBe` - ([ - Line [ span "/*", Break ], - Line [ span "*/" ] - ], Range 0 5) + describe "termToLines" $ do + it "splits multi-line terms into multiple lines" $ + termToLines (Info (Range 0 5) (Range 0 2) (Set.fromList ["comment"]) :< (Leaf "")) "/*\n*/" + `shouldBe` + ([ + Line [ span "/*", Break ], + Line [ span "*/" ] + ], Range 0 5) where rightRowText text = rightRow [ Text text ] From 15f27c5faaf29b33b4f8ff0791f3d5a1712840d6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 15:48:23 -0500 Subject: [PATCH 67/79] We have a leaf for the purposes of this test. --- test/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index 199c1e142..52d1ba431 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -109,7 +109,7 @@ main = hspec $ do describe "termToLines" $ do it "splits multi-line terms into multiple lines" $ - termToLines (Info (Range 0 5) (Range 0 2) (Set.fromList ["comment"]) :< (Leaf "")) "/*\n*/" + termToLines (Info (Range 0 5) (Range 0 2) (Set.singleton "leaf") :< (Leaf "")) "/*\n*/" `shouldBe` ([ Line [ span "/*", Break ], From 470777bde9428ef9ca85171168576af6628666ba Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 15:50:32 -0500 Subject: [PATCH 68/79] Fold using adjoin2Lines instead of combining using adjoinLines. --- src/Split.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 389a735a5..a5bf29054 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -134,11 +134,12 @@ termToLines (Info range _ categories :< syntax) source = (rows syntax, range) rewrapLineContentsInUl EmptyLine = EmptyLine lineElements r s = Line . (:[]) <$> textElements r s childLines i = appendRemainder $ foldl sumLines ([], start range) i - appendRemainder (lines, previous) = adjoinLines lines $ lineElements (Range previous (end range)) source + appendRemainder (lines, previous) = reverse . foldl adjoin2Lines [] $ lines ++ lineElements (Range previous (end range)) source sumLines (lines, previous) child = (allLines, end childRange) where separatorLines = lineElements (Range previous $ start childRange) source - allLines = lines `adjoinLines` separatorLines `adjoinLines` childLines + unadjoinedLines = lines ++ separatorLines ++ childLines + allLines = reverse $ foldl adjoin2Lines [] unadjoinedLines (childLines, childRange) = termToLines child source elements = (elementAndBreak $ Span (classify categories)) =<< actualLines (substring range source) From db23e4792d7f3f3c8d49686350f3ef4efa38f979 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 15:50:35 -0500 Subject: [PATCH 69/79] Compose. --- src/Split.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index a5bf29054..01d01aa4e 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -158,7 +158,7 @@ annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCatego ranges = (left, right) rows = appendRemainder $ foldl sumRows ([], starts ranges) i sources = (before, after) - appendRemainder (rows, previousIndices) = reverse $ foldl adjoin2 [] $ rows ++ (contextRows (ends ranges) previousIndices sources) + appendRemainder (rows, previousIndices) = reverse . foldl adjoin2 [] $ rows ++ (contextRows (ends ranges) previousIndices sources) sumRows (rows, previousIndices) child = (allRows, ends childRanges) where separatorRows = contextRows (starts childRanges) previousIndices sources From 57a30624460f1b7942e3356abfebe2167f4409ed Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 16:11:13 -0500 Subject: [PATCH 70/79] Fold adjoin2Lines over leaves. --- src/Split.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index 01d01aa4e..2c3b546fc 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -127,7 +127,7 @@ diffToRows (Pure (Replace a b)) _ before after = (replacedRows, (leftRange, righ termToLines :: Term a Info -> String -> ([Line], Range) termToLines (Info range _ categories :< syntax) source = (rows syntax, range) where - rows (Leaf _) = Line . (:[]) <$> elements + rows (Leaf _) = reverse $ foldl adjoin2Lines [] $ Line . (:[]) <$> elements rows (Indexed i) = rewrapLineContentsInUl <$> childLines i rewrapLineContentsInUl (Line elements) = Line [ Ul (classify categories) elements ] From 167ad6087b59ab7e921e7d8ce78edebb9c29963b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 16:11:44 -0500 Subject: [PATCH 71/79] Only adjoin onto open lines. --- src/Split.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index 2c3b546fc..2cc8cdef1 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -245,7 +245,8 @@ openLine (line : _) = const line <$> (join . maybeLast $ openElement <$> unLine adjoin2Lines :: [Line] -> Line -> [Line] adjoin2Lines [] line = [line] adjoin2Lines (EmptyLine : xs) line | Just _ <- openLine xs = EmptyLine : adjoin2Lines xs line -adjoin2Lines (prev:rest) line = (prev <> line) : rest +adjoin2Lines (prev:rest) line | Just _ <- openLine [ prev ] = (prev <> line) : rest +adjoin2Lines lines line = line : lines adjoinLines :: [Line] -> [Line] -> [Line] adjoinLines [] lines = lines From 69307c76d12ed5dee1277aa20fd0169e1a55a47d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 16:23:33 -0500 Subject: [PATCH 72/79] Only adjoin the rows once. --- src/Split.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 2cc8cdef1..6190c162a 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -162,8 +162,7 @@ annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCatego sumRows (rows, previousIndices) child = (allRows, ends childRanges) where separatorRows = contextRows (starts childRanges) previousIndices sources - unadjoinedRows = rows ++ separatorRows ++ childRows - allRows = reverse $ foldl adjoin2 [] unadjoinedRows + allRows = rows ++ separatorRows ++ childRows (childRows, childRanges) = diffToRows child previousIndices before after contextRows :: (Int, Int) -> (Int, Int) -> (String, String) -> [Row] From 6a73248a4687d355bd062c758b64a6df8869be4d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 16:29:18 -0500 Subject: [PATCH 73/79] Test that openLine will produce open lines. --- test/Spec.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/test/Spec.hs b/test/Spec.hs index 52d1ba431..d64f84043 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -116,6 +116,14 @@ main = hspec $ do Line [ span "*/" ] ], Range 0 5) + describe "openLine" $ do + it "should produce the earliest open line in a list" $ + openLine [ + Line [ Div (Just "delete") [ span "*/" ] ], + Line [ Div (Just "delete") [ span " * Debugging", Break ] ], + Line [ Div (Just "delete") [ span "/*", Break ] ] + ] `shouldBe` (Just $ Line [ Div (Just "delete") [ span "*/" ] ]) + where rightRowText text = rightRow [ Text text ] rightRow xs = Row EmptyLine (Line xs) From d9e63c0331173d351ab2fcb2eea42cde7ba09a86 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 16:30:52 -0500 Subject: [PATCH 74/79] Clarify a test name. --- test/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index d64f84043..ab4078925 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -117,7 +117,7 @@ main = hspec $ do ], Range 0 5) describe "openLine" $ do - it "should produce the earliest open line in a list" $ + it "should produce the earliest non-empty line in a list, if open" $ openLine [ Line [ Div (Just "delete") [ span "*/" ] ], Line [ Div (Just "delete") [ span " * Debugging", Break ] ], From 85d141e924e17b59601fecf030497d8b760a5b5a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 16:31:00 -0500 Subject: [PATCH 75/79] Test that openLine returns Nothing for closed lines. --- test/Spec.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test/Spec.hs b/test/Spec.hs index ab4078925..686530dc6 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -124,6 +124,11 @@ main = hspec $ do Line [ Div (Just "delete") [ span "/*", Break ] ] ] `shouldBe` (Just $ Line [ Div (Just "delete") [ span "*/" ] ]) + it "should return Nothing if the earliest non-empty line is closed" $ + openLine [ + Line [ Div (Just "delete") [ span " * Debugging", Break ] ] + ] `shouldBe` Nothing + where rightRowText text = rightRow [ Text text ] rightRow xs = Row EmptyLine (Line xs) From 674301ce1f6423aa58780904410c610ee429c1f9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 16:43:31 -0500 Subject: [PATCH 76/79] `Last` returns non-`Nothing`, so bind instead. --- src/Split.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Split.hs b/src/Split.hs index 6190c162a..7fb5279e0 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -231,9 +231,9 @@ rightLines rows = right <$> rows openElement :: HTML -> Maybe HTML openElement Break = Nothing -openElement (Ul _ elements) = getLast . mconcat . map Last $ openElement <$> elements -openElement (Dl _ elements) = getLast . mconcat . map Last $ openElement <$> elements -openElement (Div _ elements) = getLast . mconcat . map Last $ openElement <$> elements +openElement (Ul _ elements) = openElement =<< maybeLast elements +openElement (Dl _ elements) = openElement =<< maybeLast elements +openElement (Div _ elements) = openElement =<< maybeLast elements openElement h = Just h openLine :: [Line] -> Maybe Line From 60b9e630a87a54fa732d5c41c6708b0961a76640 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 16:43:34 -0500 Subject: [PATCH 77/79] More binding. --- src/Split.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Split.hs b/src/Split.hs index 7fb5279e0..ea9af35a8 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -239,7 +239,7 @@ openElement h = Just h openLine :: [Line] -> Maybe Line openLine [] = Nothing openLine (EmptyLine : rest) = openLine rest -openLine (line : _) = const line <$> (join . maybeLast $ openElement <$> unLine line) +openLine (line : _) = const line <$> (openElement =<< (maybeLast $ unLine line)) adjoin2Lines :: [Line] -> Line -> [Line] adjoin2Lines [] line = [line] From 7f77b39b7826508bb4b23e04307e9b7f8229c662 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 16:46:38 -0500 Subject: [PATCH 78/79] =?UTF-8?q?Don=E2=80=99t=20make=20empty=20text/etc?= =?UTF-8?q?=20nodes.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Split.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Split.hs b/src/Split.hs index ea9af35a8..deeefa728 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -173,6 +173,7 @@ contextRows childIndices previousIndices sources = zipWithMaybe rowFromMaybeRows elementAndBreak :: (String -> HTML) -> String -> [HTML] elementAndBreak _ "" = [] +elementAndBreak _ "\n" = [ Break ] elementAndBreak constructor x | '\n' <- last x = [ constructor $ init x, Break ] elementAndBreak constructor x = [ constructor x ] From a9bb3583e761ae0763c95813aa992fa7ce8c0ec6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 10 Dec 2015 16:47:10 -0500 Subject: [PATCH 79/79] Fix a faulty test. --- test/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index 686530dc6..dae6f6fc4 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -77,7 +77,7 @@ main = hspec $ do it "should split multi-line deletions across multiple rows" $ let (sourceA, sourceB) = ("/*\n*/\na", "a") in annotatedToRows (formatted sourceA sourceB "branch" (Indexed [ - Pure . Delete $ (Info (Range 0 5) (Range 0 2) (Set.fromList ["comment"]) :< (Leaf "")), + Pure . Delete $ (Info (Range 0 5) (Range 0 2) (Set.fromList ["leaf"]) :< (Leaf "")), Free . offsetAnnotated 6 0 $ unchanged "a" "leaf" (Leaf "") ])) sourceA sourceB `shouldBe` ([