From e51492b8d55275bc50a013cb38861377ccd71873 Mon Sep 17 00:00:00 2001 From: joshvera Date: Mon, 14 Dec 2015 15:52:39 -0500 Subject: [PATCH 1/4] Remove line range from Info --- app/TreeSitter.hs | 13 ++++++------- src/Diff.hs | 2 +- src/Parser.hs | 15 +++++++-------- src/Split.hs | 4 ++-- src/Unified.hs | 10 +++++----- 5 files changed, 21 insertions(+), 23 deletions(-) diff --git a/app/TreeSitter.hs b/app/TreeSitter.hs index 20e6dbf4e..6de6a5245 100644 --- a/app/TreeSitter.hs +++ b/app/TreeSitter.hs @@ -30,10 +30,10 @@ data TSNode = TsNode { _data :: Ptr (), offset :: TSLength } deriving (Show, Eq) instance Storable TSNode where - alignment n = 24 - sizeOf n = 24 - peek p = error "Haskell code should never read TSNode values directly." - poke p n = error "Haskell code should never write TSNode values directly." + alignment _ = 24 + sizeOf _ = 24 + peek _ = error "Haskell code should never read TSNode values directly." + poke _ _ = error "Haskell code should never write TSNode values directly." foreign import ccall "app/bridge.h ts_document_root_node_p" ts_document_root_node_p :: Ptr TSDocument -> Ptr TSNode -> IO () foreign import ccall "app/bridge.h ts_node_p_name" ts_node_p_name :: Ptr TSNode -> Ptr TSDocument -> IO CString @@ -71,8 +71,7 @@ documentToTerm document contents = alloca $ \root -> do name <- peekCString name children <- withNamedChildren node toTerm range <- range node - lineRange <- getLineRange node - annotation <- return . Info range lineRange $ singleton name + annotation <- return . Info range $ singleton name return (name, annotation :< case children of [] -> Leaf $ substring range contents _ | member name keyedProductions -> Keyed $ Map.fromList children @@ -86,7 +85,7 @@ withNamedChildren node transformNode = do then return [] else mapM (alloca . getChild) [0..pred count] where getChild n out = do - ts_node_p_named_child node n out + _ <- ts_node_p_named_child node n out transformNode out range :: Ptr TSNode -> IO Range diff --git a/src/Diff.hs b/src/Diff.hs index 36729b694..624c95f66 100644 --- a/src/Diff.hs +++ b/src/Diff.hs @@ -13,7 +13,7 @@ data Annotated a annotation f = Annotated annotation (Syntax a f) type Category = String -data Info = Info { characterRange :: Range, lineRange :: Range, categories :: (Set Category) } +data Info = Info { characterRange :: Range, categories :: (Set Category) } deriving (Eq, Show) instance Categorizable Info where diff --git a/src/Parser.hs b/src/Parser.hs index 262d33e2a..25c29b1a3 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -10,13 +10,12 @@ import qualified Data.Set as Set type Parser = String -> IO (Term String Info) lineByLineParser :: Parser -lineByLineParser input = return . root . Indexed $ case foldl annotateLeaves ([], 0, 0) lines of - (leaves, _, _) -> leaves +lineByLineParser input = return . root . Indexed $ case foldl annotateLeaves ([], 0) lines of + (leaves, _) -> leaves where lines = Prelude.lines input - root syntax = Info (Range 0 $ length input) (Range 0 $ length lines) Set.empty :< syntax - leaf charIndex lineIndex line = Info (Range charIndex $ charIndex + length line) (Range lineIndex $ lineIndex + 1) Set.empty :< Leaf line - annotateLeaves (accum, charIndex, lineIndex) line = - (accum ++ [ leaf charIndex lineIndex line ] - , charIndex + length line + 1 - , lineIndex + 1) + root syntax = Info (Range 0 $ length input) Set.empty :< syntax + leaf charIndex line = Info (Range charIndex $ charIndex + length line) Set.empty :< Leaf line + annotateLeaves (accum, charIndex) line = + (accum ++ [ leaf charIndex line ] + , charIndex + length line + 1) diff --git a/src/Split.hs b/src/Split.hs index 8b29573e0..af40a01de 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -152,7 +152,7 @@ diffToRows (Pure (Replace a b)) _ before after = (replacedRows, (leftRange, righ -- | 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) +termToLines (Info range categories :< syntax) source = (rows syntax, range) where rows (Leaf _) = reverse $ foldl adjoin2Lines [] $ Line . (:[]) <$> elements rows (Indexed i) = rewrapLineContentsInUl <$> childLines i @@ -173,7 +173,7 @@ termToLines (Info range _ categories :< syntax) source = (rows syntax, range) -- | 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)) -annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) syntax) before after = (rows syntax, ranges) +annotatedToRows (Annotated (Info left leftCategories, Info right rightCategories) syntax) before after = (rows syntax, ranges) where rows (Leaf _) = zipWithMaybe rowFromMaybeRows leftElements rightElements rows (Indexed i) = wrapRows i diff --git a/src/Unified.hs b/src/Unified.hs index 3ed02e620..dcc352886 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -18,10 +18,10 @@ unified diff before after = do return . mconcat . chunksToByteStrings renderer . fst $ iter g mapped where mapped = fmap (unifiedPatch &&& range) diff g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks after info syntax - annotationAndSyntaxToChunks source (Info range _ _) (Leaf _) = (pure . chunk $ substring range source, Just range) - annotationAndSyntaxToChunks source (Info range _ _) (Indexed i) = (unifiedRange range i source, Just range) - annotationAndSyntaxToChunks source (Info range _ _) (Fixed f) = (unifiedRange range f source, Just range) - annotationAndSyntaxToChunks source (Info range _ _) (Keyed k) = (unifiedRange range (sort $ snd <$> Map.toList k) source, Just range) + annotationAndSyntaxToChunks source (Info range _) (Leaf _) = (pure . chunk $ substring range source, Just range) + annotationAndSyntaxToChunks source (Info range _) (Indexed i) = (unifiedRange range i source, Just range) + annotationAndSyntaxToChunks source (Info range _) (Fixed f) = (unifiedRange range f source, Just range) + annotationAndSyntaxToChunks source (Info range _) (Keyed k) = (unifiedRange range (sort $ snd <$> Map.toList k) source, Just range) unifiedPatch :: Patch (Term a Info) -> [Chunk String] unifiedPatch patch = (fore red . bold <$> beforeChunk) <> (fore green . bold <$> afterChunk) where @@ -40,7 +40,7 @@ unified diff before after = do range :: Patch (Term a Info) -> Maybe Range range patch = range . extract <$> after patch where extract (annotation :< _) = annotation - range (Info range _ _) = range + range (Info range _) = range change :: String -> [Chunk String] -> [Chunk String] change bound content = [ chunk "{", chunk bound ] ++ content ++ [ chunk bound, chunk "}" ] From f5dadfd964810f98507854004bb0c0b87b1699b4 Mon Sep 17 00:00:00 2001 From: joshvera Date: Mon, 14 Dec 2015 16:09:12 -0500 Subject: [PATCH 2/4] fix tests --- test/Spec.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index dae6f6fc4..a5b00cc2e 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 ["leaf"]) :< (Leaf "")), + Pure . Delete $ (Info (Range 0 5) (Set.fromList ["leaf"]) :< (Leaf "")), Free . offsetAnnotated 6 0 $ unchanged "a" "leaf" (Leaf "") ])) sourceA sourceB `shouldBe` ([ @@ -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.singleton "leaf") :< (Leaf "")) "/*\n*/" + termToLines (Info (Range 0 5) (Set.singleton "leaf") :< (Leaf "")) "/*\n*/" `shouldBe` ([ Line [ span "/*", Break ], @@ -135,9 +135,9 @@ main = hspec $ do leftRowText text = leftRow [ Text text ] leftRow xs = Row (Line xs) EmptyLine rowText a b = Row (Line [ Text a ]) (Line [ Text b ]) - info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ]) + info source category = Info (totalRange source) (Set.fromList [ category ]) unchanged source category = formatted source source category formatted source1 source2 category = Annotated (info source1 category, info source2 category) - offsetInfo by (Info (Range start end) lineRange categories) = Info (Range (start + by) (end + by)) lineRange categories + offsetInfo by (Info (Range start end) categories) = Info (Range (start + by) (end + by)) categories offsetAnnotated by1 by2 (Annotated (left, right) syntax) = Annotated (offsetInfo by1 left, offsetInfo by2 right) syntax span = Span (Just "category-leaf") From 824cc801f09a5cd8f6d3960e24ff2c8734ea9aeb Mon Sep 17 00:00:00 2001 From: joshvera Date: Mon, 14 Dec 2015 17:15:40 -0500 Subject: [PATCH 3/4] Remove ts_node_p_start_point and ts_node_p_end_point --- app/TreeSitter.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/app/TreeSitter.hs b/app/TreeSitter.hs index 6de6a5245..3a1a88728 100644 --- a/app/TreeSitter.hs +++ b/app/TreeSitter.hs @@ -41,8 +41,6 @@ foreign import ccall "app/bridge.h ts_node_p_named_child_count" ts_node_p_named_ foreign import ccall "app/bridge.h ts_node_p_named_child" ts_node_p_named_child :: Ptr TSNode -> CSize -> Ptr TSNode -> IO CSize foreign import ccall "app/bridge.h ts_node_p_pos_chars" ts_node_p_pos_chars :: Ptr TSNode -> IO CSize foreign import ccall "app/bridge.h ts_node_p_size_chars" ts_node_p_size_chars :: Ptr TSNode -> IO CSize -foreign import ccall "app/bridge.h ts_node_p_start_point" ts_node_p_start_point :: Ptr TSNode -> IO CSize -foreign import ccall "app/bridge.h ts_node_p_end_point" ts_node_p_end_point :: Ptr TSNode -> IO CSize keyedProductions :: Set String keyedProductions = fromList [ "object" ] From 4d04a5b3ddf58a19323f68bb67dbbbbf57509e88 Mon Sep 17 00:00:00 2001 From: joshvera Date: Mon, 14 Dec 2015 17:15:44 -0500 Subject: [PATCH 4/4] Remove getLineRange --- app/TreeSitter.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/app/TreeSitter.hs b/app/TreeSitter.hs index 3a1a88728..1d0604ca6 100644 --- a/app/TreeSitter.hs +++ b/app/TreeSitter.hs @@ -93,9 +93,3 @@ range node = do let start = fromIntegral pos end = start + fromIntegral size return Range { start = start, end = end } - -getLineRange :: Ptr TSNode -> IO Range -getLineRange node = do - startLine <- ts_node_p_start_point node - endLine <- ts_node_p_end_point node - return Range { start = fromIntegral startLine, end = fromIntegral endLine }