From bce5430697c0d2c3f07c2eed561779c557614484 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 13:57:28 -0700 Subject: [PATCH 001/149] Stub in a JSON renderer module. --- semantic-diff.cabal | 1 + src/Renderer/JSON.hs | 1 + 2 files changed, 2 insertions(+) create mode 100644 src/Renderer/JSON.hs diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 3346291ee..e6f29af15 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -25,6 +25,7 @@ library , Data.OrderedMap , Patch , Renderer + , Renderer.JSON , Renderer.Patch , Renderer.Split , Renderer.Unified diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs new file mode 100644 index 000000000..e97131c57 --- /dev/null +++ b/src/Renderer/JSON.hs @@ -0,0 +1 @@ +module Renderer.JSON where From 561d6255382eafea74a9178afadf0aa4626ae5ce Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 14:09:11 -0700 Subject: [PATCH 002/149] Stub in a JSON datatype. --- src/Renderer/JSON.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index e97131c57..5fa007839 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -1 +1,10 @@ -module Renderer.JSON where +module Renderer.JSON ( + JSON (JSON, rows) +) where + +import Diff +import Row +import Source +import Renderer.Split + +data JSON = JSON { rows :: [Row (SplitDiff (Source Char) Info)] } From 9716e0d006caab6a243435a87bc04b926e570a9a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 14:09:38 -0700 Subject: [PATCH 003/149] Document the JSON type. --- src/Renderer/JSON.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 5fa007839..2cfb21a59 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -7,4 +7,5 @@ import Row import Source import Renderer.Split +-- | JSON representing an aligned diff. data JSON = JSON { rows :: [Row (SplitDiff (Source Char) Info)] } From e74aea88a1c21dc42679303e149d459e4e26345e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 14:10:35 -0700 Subject: [PATCH 004/149] Stub in JSON output. --- app/DiffOutput.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/app/DiffOutput.hs b/app/DiffOutput.hs index a3565bcda..299b0a894 100644 --- a/app/DiffOutput.hs +++ b/app/DiffOutput.hs @@ -8,13 +8,14 @@ import System.Directory import System.FilePath import qualified System.IO as IO import qualified Data.Text.Lazy.IO as TextIO +import qualified Renderer.JSON as J import qualified Renderer.Patch as P import Renderer.Split import Renderer.Unified import Rainbow -- | The available types of diff rendering. -data Format = Unified | Split | Patch +data Format = Unified | Split | Patch | JSON data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath, outputPath :: FilePath } @@ -36,3 +37,4 @@ printDiff parser arguments sources = case format arguments of else path IO.withFile outputPath IO.WriteMode (`TextIO.hPutStr` rendered) Patch -> putStr =<< diffFiles parser P.patch sources + JSON -> putStr "" From 1a45d0b1d642d606a6a3004a686f3bb7bda45c2b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 14:15:22 -0700 Subject: [PATCH 005/149] Stub in a JSON renderer. --- src/Renderer/JSON.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 2cfb21a59..9fb07a163 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -1,11 +1,15 @@ module Renderer.JSON ( - JSON (JSON, rows) + json ) where import Diff import Row import Source +import Renderer import Renderer.Split -- | JSON representing an aligned diff. data JSON = JSON { rows :: [Row (SplitDiff (Source Char) Info)] } + +json :: Renderer a String +json diff sources = "" From 2ae6114eb6f142c967f058496e720fdb930d1cdd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 14:15:31 -0700 Subject: [PATCH 006/149] Diff and render JSON. --- app/DiffOutput.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/DiffOutput.hs b/app/DiffOutput.hs index 299b0a894..6c1917ef7 100644 --- a/app/DiffOutput.hs +++ b/app/DiffOutput.hs @@ -37,4 +37,4 @@ printDiff parser arguments sources = case format arguments of else path IO.withFile outputPath IO.WriteMode (`TextIO.hPutStr` rendered) Patch -> putStr =<< diffFiles parser P.patch sources - JSON -> putStr "" + JSON -> putStr =<< diffFiles parser J.json sources From 41a260913d01f0f31b2dc3b3693fe8441661034a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 14:16:26 -0700 Subject: [PATCH 007/149] Add a CLI option for the JSON renderer. --- app/Main.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/app/Main.hs b/app/Main.hs index 4509d5726..3ddfdee23 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -13,6 +13,7 @@ arguments :: Parser Arguments arguments = Arguments <$> (flag DO.Split DO.Unified (long "unified" <> help "output a unified diff") <|> flag DO.Split DO.Patch (long "patch" <> help "output a patch(1)-compatible diff") + <|> flag DO.Split DO.JSON (long "json" <> help "output a json diff") <|> flag' DO.Split (long "split" <> help "output a split diff")) <*> optional (strOption (long "output" <> short 'o' <> help "output directory for split diffs, defaulting to stdout if unspecified")) <*> strArgument (metavar "FILE a") From 2da6a3527bad692bee4bdbda4895ecf576207d0e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 14:19:33 -0700 Subject: [PATCH 008/149] Test JSON. --- test/CorpusSpec.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/test/CorpusSpec.hs b/test/CorpusSpec.hs index 9e79fcd81..16ee09821 100644 --- a/test/CorpusSpec.hs +++ b/test/CorpusSpec.hs @@ -2,6 +2,7 @@ module CorpusSpec where import Diffing import Renderer +import qualified Renderer.JSON as J import qualified Renderer.Patch as P import qualified Renderer.Split as Split import qualified Renderer.Unified as Unified @@ -39,11 +40,11 @@ spec = parallel $ do let tests = correctTests =<< paths mapM_ (\ (formatName, renderer, a, b, output) -> it (normalizeName a ++ " (" ++ formatName ++ ")") $ testDiff renderer a b output matcher) tests - correctTests :: (FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer a String, FilePath, FilePath, Maybe FilePath)] - correctTests paths@(_, _, Nothing, Nothing, Nothing) = testsForPaths paths + correctTests :: (FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer a String, FilePath, FilePath, Maybe FilePath)] + correctTests paths@(_, _, Nothing, Nothing, Nothing, Nothing) = testsForPaths paths correctTests paths = List.filter (\(_, _, _, _, output) -> isJust output) $ testsForPaths paths - testsForPaths :: (FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer a String, FilePath, FilePath, Maybe FilePath)] - testsForPaths (a, b, patch, split, unified) = [ ("patch", P.patch, a, b, patch), ("split", testSplit, a, b, split), ("unified", testUnified, a, b, unified) ] + testsForPaths :: (FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer a String, FilePath, FilePath, Maybe FilePath)] + testsForPaths (a, b, json, patch, split, unified) = [ ("json", J.json, a, b, json), ("patch", P.patch, a, b, patch), ("split", testSplit, a, b, split), ("unified", testUnified, a, b, unified) ] testSplit :: Renderer a String testSplit diff sources = TL.unpack $ Split.split diff sources testUnified :: Renderer a String @@ -53,15 +54,16 @@ spec = parallel $ do -- | Return all the examples from the given directory. Examples are expected to -- | have the form "foo.A.js", "foo.B.js", "foo.unified.js". Diffs are not -- | required as the test may be verifying that the inputs don't crash. -examples :: FilePath -> IO [(FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath)] +examples :: FilePath -> IO [(FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath)] examples directory = do as <- toDict <$> globFor "*.A.*" bs <- toDict <$> globFor "*.B.*" + jsons <- toDict <$> globFor "*.json.*" patches <- toDict <$> globFor "*.patch.*" splits <- toDict <$> globFor "*.split.*" unifieds <- toDict <$> globFor "*.unified.*" let keys = Set.unions $ keysSet <$> [as, bs] - return $ (\name -> (as ! name, bs ! name, Map.lookup name patches, Map.lookup name splits, Map.lookup name unifieds)) <$> sort (Set.toList keys) + return $ (\name -> (as ! name, bs ! name, Map.lookup name jsons, Map.lookup name patches, Map.lookup name splits, Map.lookup name unifieds)) <$> sort (Set.toList keys) where globFor :: String -> IO [FilePath] From 79c7fdecdabe6c854e56346af99706c864477713 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:00:09 -0700 Subject: [PATCH 009/149] Abstract JSON over a type variable. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 9fb07a163..192a3a499 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -9,7 +9,7 @@ import Renderer import Renderer.Split -- | JSON representing an aligned diff. -data JSON = JSON { rows :: [Row (SplitDiff (Source Char) Info)] } +data JSON a = JSON { rows :: [Row (SplitDiff a Info)] } json :: Renderer a String json diff sources = "" From 5fbffece19fb52acd1c97d69123ef61aec202c40 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:00:23 -0700 Subject: [PATCH 010/149] Stub in a Show instance for JSON. --- src/Renderer/JSON.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 192a3a499..edfd25eb8 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -4,7 +4,7 @@ module Renderer.JSON ( import Diff import Row -import Source +import Source hiding ((++)) import Renderer import Renderer.Split @@ -13,3 +13,6 @@ data JSON a = JSON { rows :: [Row (SplitDiff a Info)] } json :: Renderer a String json diff sources = "" + +instance Show (JSON a) where + show (JSON _) = "{" ++ "'rows':" ++ "[" ++ "]" ++ "}" From e33cb1168eecfcfeb29c96ca2b27c662df6678ff Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:00:43 -0700 Subject: [PATCH 011/149] Split the diffs and show the rows. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index edfd25eb8..0554baa73 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -12,7 +12,7 @@ import Renderer.Split data JSON a = JSON { rows :: [Row (SplitDiff a Info)] } json :: Renderer a String -json diff sources = "" +json diff (a, b) = show . JSON . fst $ splitDiffByLines diff (0, 0) (source a, source b) instance Show (JSON a) where show (JSON _) = "{" ++ "'rows':" ++ "[" ++ "]" ++ "}" From 6d56fabcbf49b29435837b9a2141674d6425433c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:03:34 -0700 Subject: [PATCH 012/149] Stub in rendering of rows. --- src/Renderer/JSON.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 0554baa73..1a44b24fe 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -15,4 +15,5 @@ json :: Renderer a String json diff (a, b) = show . JSON . fst $ splitDiffByLines diff (0, 0) (source a, source b) instance Show (JSON a) where - show (JSON _) = "{" ++ "'rows':" ++ "[" ++ "]" ++ "}" + show (JSON rows) = "{'rows':[" ++ mconcat (showRow <$> rows) ++ "]}" + where showRow (Row left right) = "{'left':{},'right':{}}" From 0352948acafb738a973280154c351ba5fb2494cc Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:07:12 -0700 Subject: [PATCH 013/149] Document the thing. --- src/Renderer/JSON.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 1a44b24fe..a427ea754 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -11,6 +11,7 @@ import Renderer.Split -- | JSON representing an aligned diff. data JSON a = JSON { rows :: [Row (SplitDiff a Info)] } +-- | Render a diff to a string representing its JSON. json :: Renderer a String json diff (a, b) = show . JSON . fst $ splitDiffByLines diff (0, 0) (source a, source b) From c5d888a6ac03e6d96f935c6f40bdab02f6f297ee Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:16:27 -0700 Subject: [PATCH 014/149] Make it a newtype. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index a427ea754..b9d16b631 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -9,7 +9,7 @@ import Renderer import Renderer.Split -- | JSON representing an aligned diff. -data JSON a = JSON { rows :: [Row (SplitDiff a Info)] } +newtype JSON a = JSON { rows :: [Row (SplitDiff a Info)] } -- | Render a diff to a string representing its JSON. json :: Renderer a String From bb51244ffea974c5dd9249c8a21b4c8bb66344fe Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:17:05 -0700 Subject: [PATCH 015/149] Show lines. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Turn off overloaded strings so that we don’t have to annotate showLine. --- src/Renderer/JSON.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index b9d16b631..e4cd284f5 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -1,8 +1,10 @@ +{-# LANGUAGE NoOverloadedStrings #-} module Renderer.JSON ( json ) where import Diff +import Line import Row import Source hiding ((++)) import Renderer @@ -17,4 +19,6 @@ json diff (a, b) = show . JSON . fst $ splitDiffByLines diff (0, 0) (source a, s instance Show (JSON a) where show (JSON rows) = "{'rows':[" ++ mconcat (showRow <$> rows) ++ "]}" - where showRow (Row left right) = "{'left':{},'right':{}}" + where showRow (Row left right) = "{'left':" ++ showLine left ++ ",'right':" ++ showLine right ++ "}" + showLine EmptyLine = "null" + showLine (Line _) = "{}" From b593fb17831ee68e60d6dbe6c10308601cce1df5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:25:31 -0700 Subject: [PATCH 016/149] Stub in showDiff. --- src/Renderer/JSON.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index e4cd284f5..b1d3c04be 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -6,9 +6,11 @@ module Renderer.JSON ( import Diff import Line import Row -import Source hiding ((++)) import Renderer import Renderer.Split +import Source hiding ((++), toList) +import Control.Monad.Free +import Data.Foldable -- | JSON representing an aligned diff. newtype JSON a = JSON { rows :: [Row (SplitDiff a Info)] } @@ -21,4 +23,6 @@ instance Show (JSON a) where show (JSON rows) = "{'rows':[" ++ mconcat (showRow <$> rows) ++ "]}" where showRow (Row left right) = "{'left':" ++ showLine left ++ ",'right':" ++ showLine right ++ "}" showLine EmptyLine = "null" - showLine (Line _) = "{}" + showLine (Line diffs) = mconcat (showDiff <$> toList diffs) + showDiff (Pure term) = "{}" + showDiff (Free (Annotated (Info r c) syntax)) = "{}" From 1e07c5f7e09b6265dd189912d7dcdd56a1184178 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:27:44 -0700 Subject: [PATCH 017/149] Stub in patch rendering. --- src/Renderer/JSON.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index b1d3c04be..c7c944338 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -24,5 +24,9 @@ instance Show (JSON a) where where showRow (Row left right) = "{'left':" ++ showLine left ++ ",'right':" ++ showLine right ++ "}" showLine EmptyLine = "null" showLine (Line diffs) = mconcat (showDiff <$> toList diffs) - showDiff (Pure term) = "{}" + showDiff (Pure patch) = "{}" showDiff (Free (Annotated (Info r c) syntax)) = "{}" + showPatch (SplitInsert term) = "{'insert':" ++ showTerm term ++ "}" + showPatch (SplitDelete term) = "{'delete':" ++ showTerm term ++ "}" + showPatch (SplitReplace term) = "{'replace':" ++ showTerm term ++ "}" + showTerm term = "{}" From 0b1bec523f352525f02cede26c28d821f91963d2 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:28:36 -0700 Subject: [PATCH 018/149] Stub in showing info & syntax. --- src/Renderer/JSON.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index c7c944338..ab4251710 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -9,6 +9,7 @@ import Row import Renderer import Renderer.Split import Source hiding ((++), toList) +import Control.Comonad.Cofree import Control.Monad.Free import Data.Foldable @@ -29,4 +30,5 @@ instance Show (JSON a) where showPatch (SplitInsert term) = "{'insert':" ++ showTerm term ++ "}" showPatch (SplitDelete term) = "{'delete':" ++ showTerm term ++ "}" showPatch (SplitReplace term) = "{'replace':" ++ showTerm term ++ "}" - showTerm term = "{}" + showTerm (info :< syntax) = showInfoSyntax info syntax + showInfoSyntax info syntax = "{}" From 640bd6c3dd463f7035016fefe3d5dc1127755ba7 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:29:08 -0700 Subject: [PATCH 019/149] Use showInfoSyntax for Free diffs. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index ab4251710..00a932c24 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -26,7 +26,7 @@ instance Show (JSON a) where showLine EmptyLine = "null" showLine (Line diffs) = mconcat (showDiff <$> toList diffs) showDiff (Pure patch) = "{}" - showDiff (Free (Annotated (Info r c) syntax)) = "{}" + showDiff (Free (Annotated info syntax)) = showInfoSyntax info syntax showPatch (SplitInsert term) = "{'insert':" ++ showTerm term ++ "}" showPatch (SplitDelete term) = "{'delete':" ++ showTerm term ++ "}" showPatch (SplitReplace term) = "{'replace':" ++ showTerm term ++ "}" From f205a59f6d3cb477f0d0bf8e0cf0b6d2f20fcf45 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:29:24 -0700 Subject: [PATCH 020/149] Use showPatch for Pure diffs. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 00a932c24..3ba374632 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -25,7 +25,7 @@ instance Show (JSON a) where where showRow (Row left right) = "{'left':" ++ showLine left ++ ",'right':" ++ showLine right ++ "}" showLine EmptyLine = "null" showLine (Line diffs) = mconcat (showDiff <$> toList diffs) - showDiff (Pure patch) = "{}" + showDiff (Pure patch) = showPatch patch showDiff (Free (Annotated info syntax)) = showInfoSyntax info syntax showPatch (SplitInsert term) = "{'insert':" ++ showTerm term ++ "}" showPatch (SplitDelete term) = "{'delete':" ++ showTerm term ++ "}" From 543acb01c035600e05c5f985c543f95c38506779 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:31:30 -0700 Subject: [PATCH 021/149] Stub in range/categories/syntax showing. --- src/Renderer/JSON.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 3ba374632..ac2ebe7d6 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -5,6 +5,7 @@ module Renderer.JSON ( import Diff import Line +import Range import Row import Renderer import Renderer.Split @@ -31,4 +32,7 @@ instance Show (JSON a) where showPatch (SplitDelete term) = "{'delete':" ++ showTerm term ++ "}" showPatch (SplitReplace term) = "{'replace':" ++ showTerm term ++ "}" showTerm (info :< syntax) = showInfoSyntax info syntax - showInfoSyntax info syntax = "{}" + showInfoSyntax (Info range categories) syntax = "{'range':" ++ showRange range ++ ",'categories':" ++ showCategories categories ++ ",'syntax':" ++ showSyntax syntax ++ "}" + showRange (Range start end) = "{}" + showCategories c = "{}" + showSyntax syntax = "{}" From 6e74ef2a083eb4002f2a64b16023b10ad4050bb4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:32:02 -0700 Subject: [PATCH 022/149] Flesh out showRange. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index ac2ebe7d6..0890cfab9 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -33,6 +33,6 @@ instance Show (JSON a) where showPatch (SplitReplace term) = "{'replace':" ++ showTerm term ++ "}" showTerm (info :< syntax) = showInfoSyntax info syntax showInfoSyntax (Info range categories) syntax = "{'range':" ++ showRange range ++ ",'categories':" ++ showCategories categories ++ ",'syntax':" ++ showSyntax syntax ++ "}" - showRange (Range start end) = "{}" + showRange (Range start end) = "{'start':" ++ show start ++ ",'end':" ++ show end ++ "}" showCategories c = "{}" showSyntax syntax = "{}" From 3b54caefb51a7f958bc548817ac4daeec3fa916f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:33:17 -0700 Subject: [PATCH 023/149] Flesh out showCategories. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 0890cfab9..8c292becc 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -34,5 +34,5 @@ instance Show (JSON a) where showTerm (info :< syntax) = showInfoSyntax info syntax showInfoSyntax (Info range categories) syntax = "{'range':" ++ showRange range ++ ",'categories':" ++ showCategories categories ++ ",'syntax':" ++ showSyntax syntax ++ "}" showRange (Range start end) = "{'start':" ++ show start ++ ",'end':" ++ show end ++ "}" - showCategories c = "{}" + showCategories categories = "{" ++ mconcat (show <$> toList categories) ++ "}" showSyntax syntax = "{}" From a0de7145651fa45fafa138e0b1832dac1c47a150 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:36:01 -0700 Subject: [PATCH 024/149] Splat syntax out directly. --- src/Renderer/JSON.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 8c292becc..48fc7cf60 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -10,6 +10,7 @@ import Row import Renderer import Renderer.Split import Source hiding ((++), toList) +import Syntax import Control.Comonad.Cofree import Control.Monad.Free import Data.Foldable @@ -32,7 +33,10 @@ instance Show (JSON a) where showPatch (SplitDelete term) = "{'delete':" ++ showTerm term ++ "}" showPatch (SplitReplace term) = "{'replace':" ++ showTerm term ++ "}" showTerm (info :< syntax) = showInfoSyntax info syntax - showInfoSyntax (Info range categories) syntax = "{'range':" ++ showRange range ++ ",'categories':" ++ showCategories categories ++ ",'syntax':" ++ showSyntax syntax ++ "}" + showInfoSyntax (Info range categories) syntax = "{'range':" ++ showRange range ++ ",'categories':" ++ showCategories categories ++ "," ++ showSyntax syntax ++ "}" showRange (Range start end) = "{'start':" ++ show start ++ ",'end':" ++ show end ++ "}" showCategories categories = "{" ++ mconcat (show <$> toList categories) ++ "}" - showSyntax syntax = "{}" + showSyntax (Leaf _) = "type:'leaf'" + showSyntax (Indexed i) = "{}" + showSyntax (Fixed f) = "{}" + showSyntax (Keyed k) = "{}" From 13e3a0e3d16801281ee0160fb40cdafeba02733b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:49:02 -0700 Subject: [PATCH 025/149] Add record fields to Annotated. --- src/Diff.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Diff.hs b/src/Diff.hs index 9d09ac954..85d20a344 100644 --- a/src/Diff.hs +++ b/src/Diff.hs @@ -9,7 +9,7 @@ import Range import Category -- | An annotated syntax in a diff tree. -data Annotated a annotation f = Annotated !annotation !(Syntax a f) +data Annotated a annotation f = Annotated { getAnnotation :: !annotation, getSyntax :: !(Syntax a f) } deriving (Functor, Eq, Show, Foldable) -- | An annotation for a source file, including the source range and semantic From 8fcb8c3e7668de776cd96f741fe33de2a22cade1 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:49:18 -0700 Subject: [PATCH 026/149] iter/cata over diffs & patches. --- src/Renderer/JSON.hs | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 48fc7cf60..bb5b043c3 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -11,7 +11,8 @@ import Renderer import Renderer.Split import Source hiding ((++), toList) import Syntax -import Control.Comonad.Cofree +import Term +import Control.Arrow import Control.Monad.Free import Data.Foldable @@ -27,12 +28,10 @@ instance Show (JSON a) where where showRow (Row left right) = "{'left':" ++ showLine left ++ ",'right':" ++ showLine right ++ "}" showLine EmptyLine = "null" showLine (Line diffs) = mconcat (showDiff <$> toList diffs) - showDiff (Pure patch) = showPatch patch - showDiff (Free (Annotated info syntax)) = showInfoSyntax info syntax - showPatch (SplitInsert term) = "{'insert':" ++ showTerm term ++ "}" - showPatch (SplitDelete term) = "{'delete':" ++ showTerm term ++ "}" - showPatch (SplitReplace term) = "{'replace':" ++ showTerm term ++ "}" - showTerm (info :< syntax) = showInfoSyntax info syntax + showDiff diff = iter (uncurry showInfoSyntax . (getAnnotation &&& getSyntax)) (showPatch <$> diff) + showPatch (SplitInsert term) = "{'insert':" ++ cata showInfoSyntax term ++ "}" + showPatch (SplitDelete term) = "{'delete':" ++ cata showInfoSyntax term ++ "}" + showPatch (SplitReplace term) = "{'replace':" ++ cata showInfoSyntax term ++ "}" showInfoSyntax (Info range categories) syntax = "{'range':" ++ showRange range ++ ",'categories':" ++ showCategories categories ++ "," ++ showSyntax syntax ++ "}" showRange (Range start end) = "{'start':" ++ show start ++ ",'end':" ++ show end ++ "}" showCategories categories = "{" ++ mconcat (show <$> toList categories) ++ "}" From f83c2abe1aa6ce41a41379338c2b704409b0c5b4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:49:42 -0700 Subject: [PATCH 027/149] Format indexed syntaxes. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index bb5b043c3..11efa86a7 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -36,6 +36,6 @@ instance Show (JSON a) where showRange (Range start end) = "{'start':" ++ show start ++ ",'end':" ++ show end ++ "}" showCategories categories = "{" ++ mconcat (show <$> toList categories) ++ "}" showSyntax (Leaf _) = "type:'leaf'" - showSyntax (Indexed i) = "{}" + showSyntax (Indexed children) = "type:'indexed',children:" ++ mconcat children showSyntax (Fixed f) = "{}" showSyntax (Keyed k) = "{}" From 5515f63b25146bc96ef34fe97d232fdf95ba9f6e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:50:15 -0700 Subject: [PATCH 028/149] Format indexed children as an array. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 11efa86a7..4e3b2a5b2 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -36,6 +36,6 @@ instance Show (JSON a) where showRange (Range start end) = "{'start':" ++ show start ++ ",'end':" ++ show end ++ "}" showCategories categories = "{" ++ mconcat (show <$> toList categories) ++ "}" showSyntax (Leaf _) = "type:'leaf'" - showSyntax (Indexed children) = "type:'indexed',children:" ++ mconcat children + showSyntax (Indexed children) = "type:'indexed',children:[" ++ intercalate "," children ++ "]" showSyntax (Fixed f) = "{}" showSyntax (Keyed k) = "{}" From 52cf57be80af029716deb3c7dcb2108fdd5ff357 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:50:33 -0700 Subject: [PATCH 029/149] Format fixed nodes. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 4e3b2a5b2..87d2e6823 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -37,5 +37,5 @@ instance Show (JSON a) where showCategories categories = "{" ++ mconcat (show <$> toList categories) ++ "}" showSyntax (Leaf _) = "type:'leaf'" showSyntax (Indexed children) = "type:'indexed',children:[" ++ intercalate "," children ++ "]" - showSyntax (Fixed f) = "{}" + showSyntax (Fixed children) = "type:'fixed',children:[" ++ intercalate "," children ++ "]" showSyntax (Keyed k) = "{}" From d9f168e320b0f80af000c55a4e259ce124a6b480 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 16:56:56 -0700 Subject: [PATCH 030/149] Format keyed nodes. --- src/Renderer/JSON.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 87d2e6823..6a9a43cff 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -5,6 +5,7 @@ module Renderer.JSON ( import Diff import Line +import qualified Data.OrderedMap as Map import Range import Row import Renderer @@ -38,4 +39,5 @@ instance Show (JSON a) where showSyntax (Leaf _) = "type:'leaf'" showSyntax (Indexed children) = "type:'indexed',children:[" ++ intercalate "," children ++ "]" showSyntax (Fixed children) = "type:'fixed',children:[" ++ intercalate "," children ++ "]" - showSyntax (Keyed k) = "{}" + showSyntax (Keyed children) = "type:'keyed',children:{" ++ intercalate "," (uncurry showKeyValue <$> Map.toList children) ++ "}" + showKeyValue key value = "'" ++ show key ++ "': " ++ value From 688f5de0a0c06c1251b59f87faef225323166e13 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 14:16:01 -0500 Subject: [PATCH 031/149] Remove redundant imports. --- src/Renderer/Split.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/Renderer/Split.hs b/src/Renderer/Split.hs index b2ed501f6..9466bd3cb 100644 --- a/src/Renderer/Split.hs +++ b/src/Renderer/Split.hs @@ -7,7 +7,6 @@ import Category import Diff import Line import Row -import Patch import Renderer import Term import SplitDiff @@ -22,12 +21,8 @@ import qualified Text.Blaze.Html5.Attributes as A import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Text.Blaze.Html.Renderer.Text -import Data.Either import Data.Foldable -import Data.Functor.Identity import Data.Monoid -import qualified Data.OrderedMap as Map -import qualified Data.Set as Set import Source hiding ((++)) type ClassName = T.Text From 456d95e3e936de750a007eb25d8e373f7845e53b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 14:17:09 -0500 Subject: [PATCH 032/149] Remove another redundant import. --- src/DiffOutput.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/DiffOutput.hs b/src/DiffOutput.hs index 599d41748..d560e5c6e 100644 --- a/src/DiffOutput.hs +++ b/src/DiffOutput.hs @@ -1,7 +1,6 @@ module DiffOutput where import Diffing -import qualified Data.ByteString.Char8 as B1 import Parser import Source import System.Directory From ad8501c053d82db9c11b7cd3990722db2efe71c4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 14:17:16 -0500 Subject: [PATCH 033/149] Add some missing imports. --- src/Renderer/JSON.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 6a9a43cff..03917f7aa 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -3,14 +3,15 @@ module Renderer.JSON ( json ) where +import Alignment import Diff import Line import qualified Data.OrderedMap as Map import Range import Row import Renderer -import Renderer.Split import Source hiding ((++), toList) +import SplitDiff import Syntax import Term import Control.Arrow From 618fc9890310b40edd622c7b55cb42802f2bbf03 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:18:19 -0500 Subject: [PATCH 034/149] Quote the keys. --- src/Renderer/JSON.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 03917f7aa..b60e517ef 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -37,8 +37,8 @@ instance Show (JSON a) where showInfoSyntax (Info range categories) syntax = "{'range':" ++ showRange range ++ ",'categories':" ++ showCategories categories ++ "," ++ showSyntax syntax ++ "}" showRange (Range start end) = "{'start':" ++ show start ++ ",'end':" ++ show end ++ "}" showCategories categories = "{" ++ mconcat (show <$> toList categories) ++ "}" - showSyntax (Leaf _) = "type:'leaf'" - showSyntax (Indexed children) = "type:'indexed',children:[" ++ intercalate "," children ++ "]" - showSyntax (Fixed children) = "type:'fixed',children:[" ++ intercalate "," children ++ "]" - showSyntax (Keyed children) = "type:'keyed',children:{" ++ intercalate "," (uncurry showKeyValue <$> Map.toList children) ++ "}" + showSyntax (Leaf _) = "'type':'leaf'" + showSyntax (Indexed children) = "'type':'indexed','children':[" ++ intercalate "," children ++ "]" + showSyntax (Fixed children) = "'type':'fixed','children':[" ++ intercalate "," children ++ "]" + showSyntax (Keyed children) = "'type':'keyed','children':{" ++ intercalate "," (uncurry showKeyValue <$> Map.toList children) ++ "}" showKeyValue key value = "'" ++ show key ++ "': " ++ value From 8f85ad7fb3d16011676c4275ce8c2023583e3345 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:18:24 -0500 Subject: [PATCH 035/149] Intercalate lines and categories. --- src/Renderer/JSON.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index b60e517ef..fc1f77a38 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -29,14 +29,14 @@ instance Show (JSON a) where show (JSON rows) = "{'rows':[" ++ mconcat (showRow <$> rows) ++ "]}" where showRow (Row left right) = "{'left':" ++ showLine left ++ ",'right':" ++ showLine right ++ "}" showLine EmptyLine = "null" - showLine (Line diffs) = mconcat (showDiff <$> toList diffs) + showLine (Line diffs) = "[" ++ intercalate "," (showDiff <$> toList diffs) ++ "]" showDiff diff = iter (uncurry showInfoSyntax . (getAnnotation &&& getSyntax)) (showPatch <$> diff) showPatch (SplitInsert term) = "{'insert':" ++ cata showInfoSyntax term ++ "}" showPatch (SplitDelete term) = "{'delete':" ++ cata showInfoSyntax term ++ "}" showPatch (SplitReplace term) = "{'replace':" ++ cata showInfoSyntax term ++ "}" showInfoSyntax (Info range categories) syntax = "{'range':" ++ showRange range ++ ",'categories':" ++ showCategories categories ++ "," ++ showSyntax syntax ++ "}" showRange (Range start end) = "{'start':" ++ show start ++ ",'end':" ++ show end ++ "}" - showCategories categories = "{" ++ mconcat (show <$> toList categories) ++ "}" + showCategories categories = "{" ++ intercalate "," (show <$> toList categories) ++ "}" showSyntax (Leaf _) = "'type':'leaf'" showSyntax (Indexed children) = "'type':'indexed','children':[" ++ intercalate "," children ++ "]" showSyntax (Fixed children) = "'type':'fixed','children':[" ++ intercalate "," children ++ "]" From f357ae2c2d665dbf19769a7baab577601a27cd37 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:18:42 -0500 Subject: [PATCH 036/149] Categories are an array. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index fc1f77a38..3a143ef2c 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -36,7 +36,7 @@ instance Show (JSON a) where showPatch (SplitReplace term) = "{'replace':" ++ cata showInfoSyntax term ++ "}" showInfoSyntax (Info range categories) syntax = "{'range':" ++ showRange range ++ ",'categories':" ++ showCategories categories ++ "," ++ showSyntax syntax ++ "}" showRange (Range start end) = "{'start':" ++ show start ++ ",'end':" ++ show end ++ "}" - showCategories categories = "{" ++ intercalate "," (show <$> toList categories) ++ "}" + showCategories categories = "[" ++ intercalate "," (show <$> toList categories) ++ "]" showSyntax (Leaf _) = "'type':'leaf'" showSyntax (Indexed children) = "'type':'indexed','children':[" ++ intercalate "," children ++ "]" showSyntax (Fixed children) = "'type':'fixed','children':[" ++ intercalate "," children ++ "]" From f3be752e3c93093c67fe048d9f7e496a87e2a9fd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:18:58 -0500 Subject: [PATCH 037/149] Intercalate rows too. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 3a143ef2c..a4ea79037 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -26,7 +26,7 @@ json :: Renderer a String json diff (a, b) = show . JSON . fst $ splitDiffByLines diff (0, 0) (source a, source b) instance Show (JSON a) where - show (JSON rows) = "{'rows':[" ++ mconcat (showRow <$> rows) ++ "]}" + show (JSON rows) = "{'rows':[" ++ intercalate "," (showRow <$> rows) ++ "]}" where showRow (Row left right) = "{'left':" ++ showLine left ++ ",'right':" ++ showLine right ++ "}" showLine EmptyLine = "null" showLine (Line diffs) = "[" ++ intercalate "," (showDiff <$> toList diffs) ++ "]" From e9552433ce1cc17a7d1c8ea85ddf1f4be315e4e2 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:24:45 -0500 Subject: [PATCH 038/149] Sort the imports. --- src/Renderer/JSON.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index a4ea79037..2f4360580 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -4,19 +4,19 @@ module Renderer.JSON ( ) where import Alignment +import Control.Arrow +import Control.Monad.Free +import Data.Foldable +import qualified Data.OrderedMap as Map import Diff import Line -import qualified Data.OrderedMap as Map import Range -import Row import Renderer +import Row import Source hiding ((++), toList) import SplitDiff import Syntax import Term -import Control.Arrow -import Control.Monad.Free -import Data.Foldable -- | JSON representing an aligned diff. newtype JSON a = JSON { rows :: [Row (SplitDiff a Info)] } From bc2db99978b05bdcc6402c0ca647054f8cffe884 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:32:31 -0500 Subject: [PATCH 039/149] Stub in a Text.JSON module. --- semantic-diff.cabal | 1 + src/Text/JSON.hs | 1 + 2 files changed, 2 insertions(+) create mode 100644 src/Text/JSON.hs diff --git a/semantic-diff.cabal b/semantic-diff.cabal index e1bace0cc..1c853d991 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -41,6 +41,7 @@ library , SplitDiff , Syntax , Term + , Text.JSON , TreeSitter build-depends: base >= 4.8 && < 5 , blaze-html diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs new file mode 100644 index 000000000..9b57ef77b --- /dev/null +++ b/src/Text/JSON.hs @@ -0,0 +1 @@ +module Text.JSON where From 84f140977f065942de58e76cb1d5af5938725400 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:42:06 -0500 Subject: [PATCH 040/149] Define JSON types. These are intentionally source-compatible with the `json` package. --- src/Text/JSON.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index 9b57ef77b..6c3db5bb4 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -1 +1,20 @@ module Text.JSON where + +data JSValue + = JSNull + | JSBool !Bool + | JSRational Bool !Rational + | JSString JSString + | JSArray [JSValue] + | JSObject (JSObject JSValue) + +newtype JSString = JSONString { fromJSString :: String } + +toJSString :: String -> JSString +toJSString = JSONString + +newtype JSObject value = JSONObject { fromJSObject :: [(String, value)] } + +toJSObject :: [(String, value)] -> JSObject value +toJSObject = JSONObject + From f7a4c2778894b845ada6a234ff49283e624f1b03 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:42:34 -0500 Subject: [PATCH 041/149] Add in a basic JSON conversion typeclass. --- src/Text/JSON.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index 6c3db5bb4..0aa041589 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -18,3 +18,7 @@ newtype JSObject value = JSONObject { fromJSObject :: [(String, value)] } toJSObject :: [(String, value)] -> JSObject value toJSObject = JSONObject +class JSON a where + showJSON :: a -> JSValue + showJSONs :: [a] -> JSValue + showJSONs = JSArray . fmap showJSON From 95deff602c4c46dd92a03209d3aa550fe2f9f8d4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:42:46 -0500 Subject: [PATCH 042/149] Add a JSON instance covering Char and String. --- src/Text/JSON.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index 0aa041589..3fa217132 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -22,3 +22,7 @@ class JSON a where showJSON :: a -> JSValue showJSONs :: [a] -> JSValue showJSONs = JSArray . fmap showJSON + +instance JSON Char where + showJSON = showJSONs . pure + showJSONs = JSString . toJSString From a179a0fbfb33b59010b59799c859d8cdbc891664 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:43:53 -0500 Subject: [PATCH 043/149] Add a JSON instance for Integers. --- src/Text/JSON.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index 3fa217132..d7e876187 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -26,3 +26,6 @@ class JSON a where instance JSON Char where showJSON = showJSONs . pure showJSONs = JSString . toJSString + +instance JSON Integer where + showJSON = JSRational False . fromIntegral From 5eb33dc23a896cc04327bc15fff8218875864403 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:47:52 -0500 Subject: [PATCH 044/149] Add a JSON instance for Int. --- src/Text/JSON.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index d7e876187..cbc2a83e9 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -29,3 +29,6 @@ instance JSON Char where instance JSON Integer where showJSON = JSRational False . fromIntegral + +instance JSON Int where + showJSON = JSRational False . fromIntegral From 7a0e309f7ddbb24fde64e6192cabba5413c1fc6e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:48:59 -0500 Subject: [PATCH 045/149] Add a JSON instance for lists. --- src/Text/JSON.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index cbc2a83e9..da8ff05e6 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -32,3 +32,6 @@ instance JSON Integer where instance JSON Int where showJSON = JSRational False . fromIntegral + +instance JSON a => JSON [a] where + showJSON = JSArray . fmap showJSON From 8b33283c002f3adc10b8b5da9ff470086c32c4db Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:51:14 -0500 Subject: [PATCH 046/149] Add a JSONWrapper type with a JSON instance. --- src/Renderer/JSON.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 2f4360580..63d4fc7eb 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -17,6 +17,7 @@ import Source hiding ((++), toList) import SplitDiff import Syntax import Term +import Text.JSON -- | JSON representing an aligned diff. newtype JSON a = JSON { rows :: [Row (SplitDiff a Info)] } @@ -42,3 +43,8 @@ instance Show (JSON a) where showSyntax (Fixed children) = "'type':'fixed','children':[" ++ intercalate "," children ++ "]" showSyntax (Keyed children) = "'type':'keyed','children':{" ++ intercalate "," (uncurry showKeyValue <$> Map.toList children) ++ "}" showKeyValue key value = "'" ++ show key ++ "': " ++ value + +newtype JSONWrapper a = JSONWrapper { unWrap :: a } + +instance JSON a => JSON (JSONWrapper a) where + showJSON = showJSON . unWrap From bd2439ec77b80819115824deb1d4ad56b08badea Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:55:51 -0500 Subject: [PATCH 047/149] Add a JSON instance for Row. --- src/Renderer/JSON.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 63d4fc7eb..40e58f35a 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoOverloadedStrings #-} +{-# LANGUAGE FlexibleInstances, NoOverloadedStrings #-} module Renderer.JSON ( json ) where @@ -48,3 +48,8 @@ newtype JSONWrapper a = JSONWrapper { unWrap :: a } instance JSON a => JSON (JSONWrapper a) where showJSON = showJSON . unWrap + +instance JSON a => JSON (JSONWrapper (Row a)) where + showJSON (JSONWrapper (Row left right)) = JSObject $ toJSObject [("left", showLine left), ("right", showLine right)] + where showLine EmptyLine = JSNull + showLine (Line a) = showJSONs (toList a) From f48bd98690b6d8a88763f01dc57be3de8c4d2043 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:57:13 -0500 Subject: [PATCH 048/149] Add a JSON instance for Line. --- src/Renderer/JSON.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 40e58f35a..1a2bf5721 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -53,3 +53,7 @@ instance JSON a => JSON (JSONWrapper (Row a)) where showJSON (JSONWrapper (Row left right)) = JSObject $ toJSObject [("left", showLine left), ("right", showLine right)] where showLine EmptyLine = JSNull showLine (Line a) = showJSONs (toList a) + +instance JSON a => JSON (JSONWrapper (Line a)) where + showJSON (JSONWrapper EmptyLine) = JSNull + showJSON (JSONWrapper (Line a)) = showJSONs (toList a) From 4bfe19f73c76bccc4e8c5a8071980ce814422317 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:58:35 -0500 Subject: [PATCH 049/149] Remove the too-general instance. --- src/Renderer/JSON.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 1a2bf5721..bb46f3e22 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -46,9 +46,6 @@ instance Show (JSON a) where newtype JSONWrapper a = JSONWrapper { unWrap :: a } -instance JSON a => JSON (JSONWrapper a) where - showJSON = showJSON . unWrap - instance JSON a => JSON (JSONWrapper (Row a)) where showJSON (JSONWrapper (Row left right)) = JSObject $ toJSObject [("left", showLine left), ("right", showLine right)] where showLine EmptyLine = JSNull From d6d419e743cec6c2f84b693a68c5114e2bc2c698 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 16:58:45 -0500 Subject: [PATCH 050/149] Define the Row instance in terms of the Line instance. --- src/Renderer/JSON.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index bb46f3e22..0c84f421a 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -47,9 +47,7 @@ instance Show (JSON a) where newtype JSONWrapper a = JSONWrapper { unWrap :: a } instance JSON a => JSON (JSONWrapper (Row a)) where - showJSON (JSONWrapper (Row left right)) = JSObject $ toJSObject [("left", showLine left), ("right", showLine right)] - where showLine EmptyLine = JSNull - showLine (Line a) = showJSONs (toList a) + showJSON (JSONWrapper (Row left right)) = JSObject $ toJSObject [("left", showJSON (JSONWrapper left)), ("right", showJSON (JSONWrapper right))] instance JSON a => JSON (JSONWrapper (Line a)) where showJSON (JSONWrapper EmptyLine) = JSNull From f1653579a27d05f57bc33e3e89d70c594fa1a021 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:00:46 -0500 Subject: [PATCH 051/149] Add a JSON instance for Range. --- src/Renderer/JSON.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 0c84f421a..e5f47bbd5 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -52,3 +52,6 @@ instance JSON a => JSON (JSONWrapper (Row a)) where instance JSON a => JSON (JSONWrapper (Line a)) where showJSON (JSONWrapper EmptyLine) = JSNull showJSON (JSONWrapper (Line a)) = showJSONs (toList a) + +instance JSON Range where + showJSON (Range start end) = showJSON [ start, end ] From 6126287d59e1b6fe103c1d0b27227b330d088c64 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:02:16 -0500 Subject: [PATCH 052/149] Derive Eq & Show instances for the JS types. --- src/Text/JSON.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index da8ff05e6..7fe8354d3 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -7,13 +7,16 @@ data JSValue | JSString JSString | JSArray [JSValue] | JSObject (JSObject JSValue) + deriving (Eq, Show) newtype JSString = JSONString { fromJSString :: String } + deriving (Eq, Show) toJSString :: String -> JSString toJSString = JSONString newtype JSObject value = JSONObject { fromJSObject :: [(String, value)] } + deriving (Eq, Show) toJSObject :: [(String, value)] -> JSObject value toJSObject = JSONObject From 25214616c80deebe88420526bf801e464174e642 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:10:47 -0500 Subject: [PATCH 053/149] Remove the old JSON type. --- src/Renderer/JSON.hs | 23 +---------------------- 1 file changed, 1 insertion(+), 22 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index e5f47bbd5..c3a07e53b 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -19,30 +19,9 @@ import Syntax import Term import Text.JSON --- | JSON representing an aligned diff. -newtype JSON a = JSON { rows :: [Row (SplitDiff a Info)] } - -- | Render a diff to a string representing its JSON. json :: Renderer a String -json diff (a, b) = show . JSON . fst $ splitDiffByLines diff (0, 0) (source a, source b) - -instance Show (JSON a) where - show (JSON rows) = "{'rows':[" ++ intercalate "," (showRow <$> rows) ++ "]}" - where showRow (Row left right) = "{'left':" ++ showLine left ++ ",'right':" ++ showLine right ++ "}" - showLine EmptyLine = "null" - showLine (Line diffs) = "[" ++ intercalate "," (showDiff <$> toList diffs) ++ "]" - showDiff diff = iter (uncurry showInfoSyntax . (getAnnotation &&& getSyntax)) (showPatch <$> diff) - showPatch (SplitInsert term) = "{'insert':" ++ cata showInfoSyntax term ++ "}" - showPatch (SplitDelete term) = "{'delete':" ++ cata showInfoSyntax term ++ "}" - showPatch (SplitReplace term) = "{'replace':" ++ cata showInfoSyntax term ++ "}" - showInfoSyntax (Info range categories) syntax = "{'range':" ++ showRange range ++ ",'categories':" ++ showCategories categories ++ "," ++ showSyntax syntax ++ "}" - showRange (Range start end) = "{'start':" ++ show start ++ ",'end':" ++ show end ++ "}" - showCategories categories = "[" ++ intercalate "," (show <$> toList categories) ++ "]" - showSyntax (Leaf _) = "'type':'leaf'" - showSyntax (Indexed children) = "'type':'indexed','children':[" ++ intercalate "," children ++ "]" - showSyntax (Fixed children) = "'type':'fixed','children':[" ++ intercalate "," children ++ "]" - showSyntax (Keyed children) = "'type':'keyed','children':{" ++ intercalate "," (uncurry showKeyValue <$> Map.toList children) ++ "}" - showKeyValue key value = "'" ++ show key ++ "': " ++ value +json diff (a, b) = show . showJSON . fst $ splitDiffByLines diff (0, 0) (source a, source b) newtype JSONWrapper a = JSONWrapper { unWrap :: a } From a504e73b04d4fd44267b791536c0f8ec8453c4e6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:15:08 -0500 Subject: [PATCH 054/149] Some more instances. --- src/Renderer/JSON.hs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index c3a07e53b..e16a21dc8 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -4,6 +4,7 @@ module Renderer.JSON ( ) where import Alignment +import Category import Control.Arrow import Control.Monad.Free import Data.Foldable @@ -32,5 +33,16 @@ instance JSON a => JSON (JSONWrapper (Line a)) where showJSON (JSONWrapper EmptyLine) = JSNull showJSON (JSONWrapper (Line a)) = showJSONs (toList a) -instance JSON Range where - showJSON (Range start end) = showJSON [ start, end ] +instance JSON (JSONWrapper Range) where + showJSON (JSONWrapper (Range start end)) = showJSON [ start, end ] + +instance JSON (JSONWrapper Info) where + showJSON (JSONWrapper (Info range categories)) = JSObject $ toJSObject [("range", showJSON (JSONWrapper range)), ("categories", showJSON (showCategory <$> toList categories))] + where showCategory (Other s) = s + showCategory s = show s + +instance JSON (JSONWrapper (SplitDiff a Info)) where + showJSON _ = JSNull + +instance JSON a => JSON (JSONWrapper (SplitPatch a)) where + showJSON _ = JSNull From 3c4a99df187b9ea5af63d213ba656dd09fd53a88 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:17:54 -0500 Subject: [PATCH 055/149] Use an explicit instance for Category. --- src/Renderer/JSON.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index e16a21dc8..9a5f60538 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -37,9 +37,11 @@ instance JSON (JSONWrapper Range) where showJSON (JSONWrapper (Range start end)) = showJSON [ start, end ] instance JSON (JSONWrapper Info) where - showJSON (JSONWrapper (Info range categories)) = JSObject $ toJSObject [("range", showJSON (JSONWrapper range)), ("categories", showJSON (showCategory <$> toList categories))] - where showCategory (Other s) = s - showCategory s = show s + showJSON (JSONWrapper (Info range categories)) = JSObject $ toJSObject [("range", showJSON (JSONWrapper range)), ("categories", showJSON (JSONWrapper <$> toList categories))] + +instance JSON (JSONWrapper Category) where + showJSON (JSONWrapper (Other s)) = JSString $ toJSString s + showJSON (JSONWrapper s) = JSString . toJSString $ show s instance JSON (JSONWrapper (SplitDiff a Info)) where showJSON _ = JSNull From 9e2ec009a1836bc9d9248825f19b01cb60d00c3d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:19:22 -0500 Subject: [PATCH 056/149] Stub in an instance for Term. --- src/Renderer/JSON.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 9a5f60538..ebb3119a8 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -6,6 +6,7 @@ module Renderer.JSON ( import Alignment import Category import Control.Arrow +import Control.Comonad.Cofree import Control.Monad.Free import Data.Foldable import qualified Data.OrderedMap as Map @@ -48,3 +49,6 @@ instance JSON (JSONWrapper (SplitDiff a Info)) where instance JSON a => JSON (JSONWrapper (SplitPatch a)) where showJSON _ = JSNull + +instance JSON (JSONWrapper (Term leaf Info)) where + showJSON (JSONWrapper (info :< syntax)) = JSNull From 61a340895e521d6e35dbc4766f4c52786956c064 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:19:59 -0500 Subject: [PATCH 057/149] Wrap some things. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index ebb3119a8..98bea7de9 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -23,7 +23,7 @@ import Text.JSON -- | Render a diff to a string representing its JSON. json :: Renderer a String -json diff (a, b) = show . showJSON . fst $ splitDiffByLines diff (0, 0) (source a, source b) +json diff (a, b) = show . showJSON . JSONWrapper . fmap (fmap JSONWrapper) . fst $ splitDiffByLines diff (0, 0) (source a, source b) newtype JSONWrapper a = JSONWrapper { unWrap :: a } From fdab783d8f334db709b75162cbc606eaafd12889 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:23:16 -0500 Subject: [PATCH 058/149] Stub in an instance over Syntax. --- src/Renderer/JSON.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 98bea7de9..30e2ade40 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -52,3 +52,7 @@ instance JSON a => JSON (JSONWrapper (SplitPatch a)) where instance JSON (JSONWrapper (Term leaf Info)) where showJSON (JSONWrapper (info :< syntax)) = JSNull + +instance JSON recur => JSON (JSONWrapper (Syntax leaf recur)) where + showJSON (JSONWrapper (Leaf _)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "leaf") ] + showJSON _ = JSNull From 427b529bbb6ebfbfeca2e3e4161fdaf3af9a29f2 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:23:26 -0500 Subject: [PATCH 059/149] Flesh out the JSON instance for Term a little. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 30e2ade40..d8a05481e 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -51,7 +51,7 @@ instance JSON a => JSON (JSONWrapper (SplitPatch a)) where showJSON _ = JSNull instance JSON (JSONWrapper (Term leaf Info)) where - showJSON (JSONWrapper (info :< syntax)) = JSNull + showJSON (JSONWrapper (info :< syntax)) = JSObject $ toJSObject [("info", showJSON (JSONWrapper info)), ("syntax", showJSON (JSONWrapper $ JSONWrapper <$> syntax))] instance JSON recur => JSON (JSONWrapper (Syntax leaf recur)) where showJSON (JSONWrapper (Leaf _)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "leaf") ] From 2c4ae8246c59b9eb78cc74e6cba196888657d39d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:24:51 -0500 Subject: [PATCH 060/149] Implement showJSON over Indexed nodes. --- src/Renderer/JSON.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index d8a05481e..32647456f 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -55,4 +55,5 @@ instance JSON (JSONWrapper (Term leaf Info)) where instance JSON recur => JSON (JSONWrapper (Syntax leaf recur)) where showJSON (JSONWrapper (Leaf _)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "leaf") ] + showJSON (JSONWrapper (Indexed i)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "indexed"), ("children", showJSON i) ] showJSON _ = JSNull From 7e71de3ec251fe61cda55ef45d8810d2aee6b369 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:25:12 -0500 Subject: [PATCH 061/149] Implement showJSON over Fixed nodes. --- src/Renderer/JSON.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 32647456f..4e4dbfe86 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -56,4 +56,5 @@ instance JSON (JSONWrapper (Term leaf Info)) where instance JSON recur => JSON (JSONWrapper (Syntax leaf recur)) where showJSON (JSONWrapper (Leaf _)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "leaf") ] showJSON (JSONWrapper (Indexed i)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "indexed"), ("children", showJSON i) ] + showJSON (JSONWrapper (Fixed i)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "fixed"), ("children", showJSON i) ] showJSON _ = JSNull From 0657e55272dd72669945df82d5a21a6e236b53d3 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:27:37 -0500 Subject: [PATCH 062/149] Flesh out the JSON instance for SplitPatch. --- src/Renderer/JSON.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 4e4dbfe86..19bcf91b5 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -48,7 +48,9 @@ instance JSON (JSONWrapper (SplitDiff a Info)) where showJSON _ = JSNull instance JSON a => JSON (JSONWrapper (SplitPatch a)) where - showJSON _ = JSNull + showJSON (JSONWrapper (SplitInsert term)) = JSObject $ toJSObject [ ("insert", showJSON term) ] + showJSON (JSONWrapper (SplitDelete term)) = JSObject $ toJSObject [ ("delete", showJSON term) ] + showJSON (JSONWrapper (SplitReplace term)) = JSObject $ toJSObject [ ("replace", showJSON term) ] instance JSON (JSONWrapper (Term leaf Info)) where showJSON (JSONWrapper (info :< syntax)) = JSObject $ toJSObject [("info", showJSON (JSONWrapper info)), ("syntax", showJSON (JSONWrapper $ JSONWrapper <$> syntax))] From 47c71a0acfd61c298f4eb9c3543680eb25d436c9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:28:23 -0500 Subject: [PATCH 063/149] Wrap each Row. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 19bcf91b5..9aa0b7176 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -23,7 +23,7 @@ import Text.JSON -- | Render a diff to a string representing its JSON. json :: Renderer a String -json diff (a, b) = show . showJSON . JSONWrapper . fmap (fmap JSONWrapper) . fst $ splitDiffByLines diff (0, 0) (source a, source b) +json diff (a, b) = show . showJSON . fmap JSONWrapper . fmap (fmap JSONWrapper) . fst $ splitDiffByLines diff (0, 0) (source a, source b) newtype JSONWrapper a = JSONWrapper { unWrap :: a } From 466d7d36110fb9377b285e72a2aae2d87aaf76a2 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:30:39 -0500 Subject: [PATCH 064/149] Write a custom Show instance for JSString. --- src/Text/JSON.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index 7fe8354d3..4f21209ec 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -10,7 +10,10 @@ data JSValue deriving (Eq, Show) newtype JSString = JSONString { fromJSString :: String } - deriving (Eq, Show) + deriving (Eq) + +instance Show JSString where + show (JSONString s) = "\"" ++ s ++ "\"" toJSString :: String -> JSString toJSString = JSONString From e39d728af0af136f8b89641fa2d6473f2d79677c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:33:19 -0500 Subject: [PATCH 065/149] Write a custom Show instance for JSObject. --- src/Text/JSON.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index 4f21209ec..a26c6c283 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -1,5 +1,7 @@ module Text.JSON where +import Data.List + data JSValue = JSNull | JSBool !Bool @@ -19,7 +21,11 @@ toJSString :: String -> JSString toJSString = JSONString newtype JSObject value = JSONObject { fromJSObject :: [(String, value)] } - deriving (Eq, Show) + deriving (Eq) + +instance Show value => Show (JSObject value) where + show (JSONObject pairs) = "{" ++ intercalate "," (showPair <$> pairs) ++ "}" + where showPair (key, value) = show (toJSString key) ++ ":" ++ show value toJSObject :: [(String, value)] -> JSObject value toJSObject = JSONObject From 5539d11d9a410d23a8736022db4c3370301f7a6c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:37:33 -0500 Subject: [PATCH 066/149] Write a custom Show instance for JSValue. --- src/Text/JSON.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index a26c6c283..9d4cf6460 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -1,6 +1,7 @@ module Text.JSON where import Data.List +import Data.Ratio data JSValue = JSNull @@ -9,7 +10,16 @@ data JSValue | JSString JSString | JSArray [JSValue] | JSObject (JSObject JSValue) - deriving (Eq, Show) + deriving (Eq) + +instance Show JSValue where + show JSNull = "null" + show (JSBool isTrue) = if isTrue then "true" else "false" + show (JSRational True rational) = show (fromRational rational :: Double) + show (JSRational False rational) = show (numerator rational :: Integer) + show (JSString s) = show s + show (JSArray v) = "[" ++ intercalate "," (show <$> v) ++ "]" + show (JSObject o) = show o newtype JSString = JSONString { fromJSString :: String } deriving (Eq) From 96649aa0e48b63ed62751de01880ac5c55d27d7d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:41:29 -0500 Subject: [PATCH 067/149] Implement showJSON over Keyed nodes. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 9aa0b7176..2c27ca56e 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -59,4 +59,4 @@ instance JSON recur => JSON (JSONWrapper (Syntax leaf recur)) where showJSON (JSONWrapper (Leaf _)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "leaf") ] showJSON (JSONWrapper (Indexed i)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "indexed"), ("children", showJSON i) ] showJSON (JSONWrapper (Fixed i)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "fixed"), ("children", showJSON i) ] - showJSON _ = JSNull + showJSON (JSONWrapper (Keyed k)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "fixed"), ("children", JSObject $ toJSObject ((\ (k, v) -> (show k, showJSON v)) <$> (Map.toList k))) ] From 258f7e6eed01d13905e81709fdcc89fb7bc6a8b0 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:44:44 -0500 Subject: [PATCH 068/149] SplitPatch is a Functor. --- src/SplitDiff.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/SplitDiff.hs b/src/SplitDiff.hs index 84fd7ac9e..5b4ea0a94 100644 --- a/src/SplitDiff.hs +++ b/src/SplitDiff.hs @@ -6,7 +6,7 @@ import Term (Term) -- | A patch to only one side of a diff. data SplitPatch a = SplitInsert a | SplitDelete a | SplitReplace a - deriving (Show, Eq) + deriving (Show, Eq, Functor) -- | Get the term from a split patch. getSplitTerm :: SplitPatch a -> a From 4b543f45f1bf718e3b1c7ac83751c89f03af25b5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 17:44:57 -0500 Subject: [PATCH 069/149] Flesh out JSON rendering for SplitDiff. --- src/Renderer/JSON.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 2c27ca56e..bd5c11ba4 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -45,7 +45,8 @@ instance JSON (JSONWrapper Category) where showJSON (JSONWrapper s) = JSString . toJSString $ show s instance JSON (JSONWrapper (SplitDiff a Info)) where - showJSON _ = JSNull + showJSON (JSONWrapper (Free (Annotated info syntax))) = JSObject $ toJSObject [("info", showJSON (JSONWrapper info)), ("syntax", showJSON (JSONWrapper $ JSONWrapper <$> syntax))] + showJSON (JSONWrapper (Pure patch)) = showJSON (JSONWrapper $ JSONWrapper <$> patch) instance JSON a => JSON (JSONWrapper (SplitPatch a)) where showJSON (JSONWrapper (SplitInsert term)) = JSObject $ toJSObject [ ("insert", showJSON term) ] From 9fe9864fbf5434d2321890985fab29a3643e7378 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 18:00:34 -0500 Subject: [PATCH 070/149] Escape some things. --- src/Text/JSON.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs index 9d4cf6460..2c9bafeea 100644 --- a/src/Text/JSON.hs +++ b/src/Text/JSON.hs @@ -25,7 +25,15 @@ newtype JSString = JSONString { fromJSString :: String } deriving (Eq) instance Show JSString where - show (JSONString s) = "\"" ++ s ++ "\"" + show (JSONString s) = "\"" ++ (s >>= escape) ++ "\"" + where escape '\\' = "\\" + escape '\n' = "\\n" + escape '\r' = "\\r" + escape '\t' = "\\t" + escape '\b' = "\\b" + escape '\"' = "\\\"" + escape '\'' = "\\'" + escape c = pure c toJSString :: String -> JSString toJSString = JSONString From adf7b24bc799e984f6f9560ebfff73870d8aaded Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 18:06:06 -0500 Subject: [PATCH 071/149] :fire: Text.JSON, just use the json package. --- semantic-diff.cabal | 2 +- src/Text/JSON.hs | 67 --------------------------------------------- 2 files changed, 1 insertion(+), 68 deletions(-) delete mode 100644 src/Text/JSON.hs diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 1c853d991..026f177c1 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -41,7 +41,6 @@ library , SplitDiff , Syntax , Term - , Text.JSON , TreeSitter build-depends: base >= 4.8 && < 5 , blaze-html @@ -50,6 +49,7 @@ library , containers , directory , filepath + , json , mtl , text >= 1.2.1.3 , text-icu diff --git a/src/Text/JSON.hs b/src/Text/JSON.hs deleted file mode 100644 index 2c9bafeea..000000000 --- a/src/Text/JSON.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Text.JSON where - -import Data.List -import Data.Ratio - -data JSValue - = JSNull - | JSBool !Bool - | JSRational Bool !Rational - | JSString JSString - | JSArray [JSValue] - | JSObject (JSObject JSValue) - deriving (Eq) - -instance Show JSValue where - show JSNull = "null" - show (JSBool isTrue) = if isTrue then "true" else "false" - show (JSRational True rational) = show (fromRational rational :: Double) - show (JSRational False rational) = show (numerator rational :: Integer) - show (JSString s) = show s - show (JSArray v) = "[" ++ intercalate "," (show <$> v) ++ "]" - show (JSObject o) = show o - -newtype JSString = JSONString { fromJSString :: String } - deriving (Eq) - -instance Show JSString where - show (JSONString s) = "\"" ++ (s >>= escape) ++ "\"" - where escape '\\' = "\\" - escape '\n' = "\\n" - escape '\r' = "\\r" - escape '\t' = "\\t" - escape '\b' = "\\b" - escape '\"' = "\\\"" - escape '\'' = "\\'" - escape c = pure c - -toJSString :: String -> JSString -toJSString = JSONString - -newtype JSObject value = JSONObject { fromJSObject :: [(String, value)] } - deriving (Eq) - -instance Show value => Show (JSObject value) where - show (JSONObject pairs) = "{" ++ intercalate "," (showPair <$> pairs) ++ "}" - where showPair (key, value) = show (toJSString key) ++ ":" ++ show value - -toJSObject :: [(String, value)] -> JSObject value -toJSObject = JSONObject - -class JSON a where - showJSON :: a -> JSValue - showJSONs :: [a] -> JSValue - showJSONs = JSArray . fmap showJSON - -instance JSON Char where - showJSON = showJSONs . pure - showJSONs = JSString . toJSString - -instance JSON Integer where - showJSON = JSRational False . fromIntegral - -instance JSON Int where - showJSON = JSRational False . fromIntegral - -instance JSON a => JSON [a] where - showJSON = JSArray . fmap showJSON From 7b3902be9e983e35f58d54e95948e2977a847266 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 18:08:33 -0500 Subject: [PATCH 072/149] Encode rather than showing. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index bd5c11ba4..7ffdfe90e 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -23,7 +23,7 @@ import Text.JSON -- | Render a diff to a string representing its JSON. json :: Renderer a String -json diff (a, b) = show . showJSON . fmap JSONWrapper . fmap (fmap JSONWrapper) . fst $ splitDiffByLines diff (0, 0) (source a, source b) +json diff (a, b) = encode . showJSON . fmap JSONWrapper . fmap (fmap JSONWrapper) . fst $ splitDiffByLines diff (0, 0) (source a, source b) newtype JSONWrapper a = JSONWrapper { unWrap :: a } From 39b86b288659415bb477c99700354e7809be3329 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 18:12:08 -0500 Subject: [PATCH 073/149] Add a test case for dictionary.js in json format. --- test/diffs/dictionary.json.js | 1 + 1 file changed, 1 insertion(+) create mode 100644 test/diffs/dictionary.json.js diff --git a/test/diffs/dictionary.json.js b/test/diffs/dictionary.json.js new file mode 100644 index 000000000..9b78a419e --- /dev/null +++ b/test/diffs/dictionary.json.js @@ -0,0 +1 @@ +[{"left":[{"info":{"range":[0,2],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,2],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,2],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{}}}]}}]}}],"right":[{"info":{"range":[0,2],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,2],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,2],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{}}}]}}]}}]},{"left":[{"info":{"range":[2,12],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[2,12],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[2,12],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{"\"\\\"b\\\"\"":{"info":{"range":[4,10],"categories":["Pair"]},"syntax":{"type":"fixed","children":[{"info":{"range":[4,7],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[4,5],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[5,6],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[6,7],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}},{"replace":{"info":{"range":[9,10],"categories":["number"]},"syntax":{"type":"leaf"}}}]}}}}}]}}]}}],"right":[{"info":{"range":[2,12],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[2,12],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[2,12],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{"\"\\\"b\\\"\"":{"info":{"range":[4,10],"categories":["Pair"]},"syntax":{"type":"fixed","children":[{"info":{"range":[4,7],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[4,5],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[5,6],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[6,7],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}},{"replace":{"info":{"range":[9,10],"categories":["number"]},"syntax":{"type":"leaf"}}}]}}}}}]}}]}}]},{"left":[{"info":{"range":[12,21],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,21],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,21],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{"\"\\\"a\\\"\"":{"info":{"range":[14,20],"categories":["Pair"]},"syntax":{"type":"fixed","children":[{"info":{"range":[14,17],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[14,15],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[15,16],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[16,17],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[19,20],"categories":["number"]},"syntax":{"type":"leaf"}}]}}}}}]}}]}}],"right":[{"info":{"range":[12,21],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,21],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,21],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{"\"\\\"a\\\"\"":{"info":{"range":[14,20],"categories":["Pair"]},"syntax":{"type":"fixed","children":[{"info":{"range":[14,17],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[14,15],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[15,16],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[16,17],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[19,20],"categories":["number"]},"syntax":{"type":"leaf"}}]}}}}}]}}]}}]},{"left":[{"info":{"range":[21,23],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[21,23],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[21,22],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{}}}]}}]}}],"right":[{"info":{"range":[21,23],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[21,23],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[21,22],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{}}}]}}]}}]},{"left":[{"info":{"range":[23,23],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[23,23],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[]}}]}}],"right":[{"info":{"range":[23,23],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[23,23],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[]}}]}}]}] \ No newline at end of file From fe6c42da4ccb72b1437988290a510aa6765b2e13 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 18:13:23 -0500 Subject: [PATCH 074/149] Add newline at eof & no newline at eof test cases. --- test/diffs/newline-at-eof.json.js | 1 + test/diffs/no-newline-at-eof.json.js | 1 + 2 files changed, 2 insertions(+) create mode 100644 test/diffs/newline-at-eof.json.js create mode 100644 test/diffs/no-newline-at-eof.json.js diff --git a/test/diffs/newline-at-eof.json.js b/test/diffs/newline-at-eof.json.js new file mode 100644 index 000000000..16584186e --- /dev/null +++ b/test/diffs/newline-at-eof.json.js @@ -0,0 +1 @@ +[{"left":[{"info":{"range":[0,29],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,28],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,27],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,11],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,7],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[8,11],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[12,26],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,26],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,13],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[13,18],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[18,19],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[20,25],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[25,26],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}]}}],"right":[{"info":{"range":[0,29],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,28],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,27],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,11],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,7],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[8,11],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[12,26],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,26],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,13],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[13,18],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[18,19],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[20,25],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[25,26],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}]}}]},{"left":null,"right":[{"info":{"range":[29,30],"categories":["program"]},"syntax":{"type":"indexed","children":[]}}]},{"left":null,"right":[{"info":{"range":[30,56],"categories":["program"]},"syntax":{"type":"indexed","children":[{"insert":{"info":{"range":[30,55],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,54],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,41],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,37],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[38,41],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[42,53],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[42,53],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[42,43],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[43,52],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[52,53],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}}]}}]},{"left":[{"info":{"range":[29,29],"categories":["program"]},"syntax":{"type":"indexed","children":[]}}],"right":[{"info":{"range":[56,56],"categories":["program"]},"syntax":{"type":"indexed","children":[]}}]}] \ No newline at end of file diff --git a/test/diffs/no-newline-at-eof.json.js b/test/diffs/no-newline-at-eof.json.js new file mode 100644 index 000000000..de56ec174 --- /dev/null +++ b/test/diffs/no-newline-at-eof.json.js @@ -0,0 +1 @@ +[{"left":[{"info":{"range":[0,28],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,28],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,27],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,11],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,7],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[8,11],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[12,26],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,26],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,13],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[13,18],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[18,19],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[20,25],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[25,26],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}]}}],"right":[{"info":{"range":[0,29],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,28],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,27],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,11],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,7],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[8,11],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[12,26],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,26],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,13],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[13,18],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[18,19],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[20,25],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[25,26],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}]}}]},{"left":null,"right":[{"info":{"range":[29,30],"categories":["program"]},"syntax":{"type":"indexed","children":[]}}]},{"left":null,"right":[{"info":{"range":[30,55],"categories":["program"]},"syntax":{"type":"indexed","children":[{"insert":{"info":{"range":[30,55],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,54],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,41],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,37],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[38,41],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[42,53],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[42,53],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[42,43],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[43,52],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[52,53],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}}]}}]}] \ No newline at end of file From d02f6484dbf81219147ca61a1fcb8e621b353aa8 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 20:38:41 -0500 Subject: [PATCH 075/149] Generic instances everywhere, why not. --- src/Category.hs | 5 +++-- src/Control/Comonad/Cofree.hs | 4 +++- src/Control/Monad/Free.hs | 4 +++- src/Data/OrderedMap.hs | 3 ++- src/Diff.hs | 17 +++++++++-------- src/Line.hs | 3 ++- src/Range.hs | 5 +++-- src/Row.hs | 3 ++- src/Source.hs | 4 ++-- src/SplitDiff.hs | 3 ++- src/Syntax.hs | 3 ++- 11 files changed, 33 insertions(+), 21 deletions(-) diff --git a/src/Category.hs b/src/Category.hs index f90ee8a12..5cf370543 100644 --- a/src/Category.hs +++ b/src/Category.hs @@ -1,9 +1,10 @@ {-# LANGUAGE FlexibleInstances #-} module Category where -import Term import Control.Comonad.Cofree import Data.Set +import GHC.Generics +import Term -- | A standardized category of AST node. Used to determine the semantics for -- | semantic diffing and define comparability of nodes. @@ -24,7 +25,7 @@ data Category = | SymbolLiteral -- | A non-standard category, which can be used for comparability. | Other String - deriving (Eq, Show, Ord) + deriving (Eq, Ord, Generic, Show) -- | The class of types that have categories. class Categorizable a where diff --git a/src/Control/Comonad/Cofree.hs b/src/Control/Comonad/Cofree.hs index bf80577e6..b1129745d 100644 --- a/src/Control/Comonad/Cofree.hs +++ b/src/Control/Comonad/Cofree.hs @@ -1,8 +1,10 @@ {-# LANGUAGE UndecidableInstances #-} module Control.Comonad.Cofree where +import GHC.Generics + data Cofree functor annotation = annotation :< (functor (Cofree functor annotation)) - deriving (Functor, Foldable, Traversable) + deriving (Functor, Foldable, Generic, Traversable) instance (Eq annotation, Eq (functor (Cofree functor annotation))) => Eq (Cofree functor annotation) where a :< f == b :< g = a == b && f == g diff --git a/src/Control/Monad/Free.hs b/src/Control/Monad/Free.hs index 4c7a1271c..1c33f82d1 100644 --- a/src/Control/Monad/Free.hs +++ b/src/Control/Monad/Free.hs @@ -1,8 +1,10 @@ {-# LANGUAGE UndecidableInstances #-} module Control.Monad.Free where +import GHC.Generics + data Free functor pure = Free (functor (Free functor pure)) | Pure pure - deriving (Functor, Foldable, Traversable) + deriving (Functor, Foldable, Generic, Traversable) instance (Eq pure, Eq (functor (Free functor pure))) => Eq (Free functor pure) where Pure a == Pure b = a == b diff --git a/src/Data/OrderedMap.hs b/src/Data/OrderedMap.hs index 345a5b7df..759b47dc6 100644 --- a/src/Data/OrderedMap.hs +++ b/src/Data/OrderedMap.hs @@ -14,10 +14,11 @@ module Data.OrderedMap ( ) where import qualified Data.Maybe as Maybe +import GHC.Generics -- | An ordered map of keys and values. data OrderedMap key value = OrderedMap { toList :: [(key, value)] } - deriving (Show, Eq, Functor, Foldable, Traversable) + deriving (Eq, Foldable, Functor, Generic, Show, Traversable) instance Eq key => Monoid (OrderedMap key value) where mempty = fromList [] diff --git a/src/Diff.hs b/src/Diff.hs index 85d20a344..6fd729876 100644 --- a/src/Diff.hs +++ b/src/Diff.hs @@ -1,21 +1,22 @@ module Diff where -import Syntax -import Data.Set -import Control.Monad.Free -import Patch -import Term -import Range import Category +import Control.Monad.Free +import Data.Set +import GHC.Generics +import Patch +import Range +import Syntax +import Term -- | An annotated syntax in a diff tree. data Annotated a annotation f = Annotated { getAnnotation :: !annotation, getSyntax :: !(Syntax a f) } - deriving (Functor, Eq, Show, Foldable) + deriving (Foldable, Functor, Generic, Eq, Show, Traversable) -- | An annotation for a source file, including the source range and semantic -- | categories. data Info = Info { characterRange :: !Range, categories :: !(Set Category) } - deriving (Eq, Show) + deriving (Eq, Generic, Show) instance Categorizable Info where categories = Diff.categories diff --git a/src/Line.hs b/src/Line.hs index 05d2336d9..b738977a9 100644 --- a/src/Line.hs +++ b/src/Line.hs @@ -4,6 +4,7 @@ module Line where import qualified Data.Foldable as Foldable import Data.Monoid import qualified Data.Vector as Vector +import GHC.Generics import Text.Blaze.Html5 hiding (map) import qualified Text.Blaze.Html5.Attributes as A @@ -11,7 +12,7 @@ import qualified Text.Blaze.Html5.Attributes as A data Line a = Line (Vector.Vector a) | EmptyLine - deriving (Eq, Functor, Foldable) + deriving (Eq, Foldable, Functor, Generic, Traversable) -- | Create a line from a list of items. makeLine :: [a] -> Line a diff --git a/src/Range.hs b/src/Range.hs index 8b5408a84..0c2b6e26c 100644 --- a/src/Range.hs +++ b/src/Range.hs @@ -1,15 +1,16 @@ {-# LANGUAGE FlexibleInstances #-} module Range where -import qualified Data.Text as T import Control.Applicative ((<|>)) import qualified Data.Char as Char import Data.Maybe (fromMaybe) import Data.Option +import qualified Data.Text as T +import GHC.Generics -- | A half-open interval of integers, defined by start & end indices. data Range = Range { start :: !Int, end :: !Int } - deriving (Eq, Show) + deriving (Eq, Show, Generic) -- | Return the length of the range. rangeLength :: Range -> Int diff --git a/src/Row.hs b/src/Row.hs index c4ac66895..789bc4b28 100644 --- a/src/Row.hs +++ b/src/Row.hs @@ -1,11 +1,12 @@ module Row where import Control.Arrow +import GHC.Generics import Line -- | A row in a split diff, composed of a before line and an after line. data Row a = Row { unLeft :: !(Line a), unRight :: !(Line a) } - deriving (Eq, Functor) + deriving (Eq, Foldable, Functor, Generic, Traversable) -- | Return a tuple of lines from the row. unRow :: Row a -> (Line a, Line a) diff --git a/src/Source.hs b/src/Source.hs index 070c8621a..117b08e5f 100644 --- a/src/Source.hs +++ b/src/Source.hs @@ -1,8 +1,8 @@ module Source where -import Range -import qualified Data.Vector as Vector import qualified Data.Text as T +import qualified Data.Vector as Vector +import Range data SourceBlob = SourceBlob { source :: Source Char, oid :: String, path :: FilePath } diff --git a/src/SplitDiff.hs b/src/SplitDiff.hs index 5b4ea0a94..2696431ab 100644 --- a/src/SplitDiff.hs +++ b/src/SplitDiff.hs @@ -1,12 +1,13 @@ module SplitDiff where +import GHC.Generics import Diff (Annotated) import Control.Monad.Free (Free) import Term (Term) -- | A patch to only one side of a diff. data SplitPatch a = SplitInsert a | SplitDelete a | SplitReplace a - deriving (Show, Eq, Functor) + deriving (Show, Eq, Functor, Generic) -- | Get the term from a split patch. getSplitTerm :: SplitPatch a -> a diff --git a/src/Syntax.hs b/src/Syntax.hs index 6c35d2d5b..f37b985a7 100644 --- a/src/Syntax.hs +++ b/src/Syntax.hs @@ -2,6 +2,7 @@ module Syntax where import Data.OrderedMap import qualified Data.Text as T +import GHC.Generics -- | A node in an abstract syntax tree. data Syntax @@ -16,4 +17,4 @@ data Syntax | Fixed [f] -- | A branch of child nodes indexed by some String identity. This is useful for identifying e.g. methods & properties in a class scope by their names. Note that comments can generally occur in these scopes as well; one strategy for dealing with this is to identify comments by their text in the source. | Keyed (OrderedMap T.Text f) - deriving (Functor, Show, Eq, Foldable, Traversable) + deriving (Eq, Foldable, Functor, Generic, Show, Traversable) From d92bab31fd71e1278dd2b0d20719b81b870f0e28 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 20:52:30 -0500 Subject: [PATCH 076/149] Generate the JSON with aeson instead. --- semantic-diff.cabal | 4 +-- src/DiffOutput.hs | 11 ++++---- src/Renderer/JSON.hs | 64 +++++++++++++------------------------------- test/CorpusSpec.hs | 12 +++++---- 4 files changed, 33 insertions(+), 58 deletions(-) diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 026f177c1..203e377f1 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -42,14 +42,14 @@ library , Syntax , Term , TreeSitter - build-depends: base >= 4.8 && < 5 + build-depends: aeson + , base >= 4.8 && < 5 , blaze-html , blaze-markup , bytestring , containers , directory , filepath - , json , mtl , text >= 1.2.1.3 , text-icu diff --git a/src/DiffOutput.hs b/src/DiffOutput.hs index d560e5c6e..bfa1601ec 100644 --- a/src/DiffOutput.hs +++ b/src/DiffOutput.hs @@ -1,15 +1,16 @@ module DiffOutput where +import qualified Data.Text.Lazy.IO as TextIO +import qualified Data.ByteString.Lazy as B import Diffing import Parser +import qualified Renderer.JSON as J +import qualified Renderer.Patch as P +import Renderer.Split import Source import System.Directory import System.FilePath import qualified System.IO as IO -import qualified Data.Text.Lazy.IO as TextIO -import qualified Renderer.JSON as J -import qualified Renderer.Patch as P -import Renderer.Split -- | The available types of diff rendering. data Format = Split | Patch | JSON @@ -29,4 +30,4 @@ printDiff parser arguments sources = case format arguments of else path IO.withFile outputPath IO.WriteMode (`TextIO.hPutStr` rendered) Patch -> putStr =<< diffFiles parser P.patch sources - JSON -> putStr =<< diffFiles parser J.json sources + JSON -> B.putStr =<< diffFiles parser J.json sources diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 7ffdfe90e..435f72f9b 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -1,63 +1,35 @@ -{-# LANGUAGE FlexibleInstances, NoOverloadedStrings #-} +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} module Renderer.JSON ( json ) where import Alignment import Category -import Control.Arrow -import Control.Comonad.Cofree -import Control.Monad.Free -import Data.Foldable -import qualified Data.OrderedMap as Map +import Data.Aeson hiding (json) +import Data.ByteString.Lazy +import Data.OrderedMap import Diff import Line import Range import Renderer import Row -import Source hiding ((++), toList) +import Source import SplitDiff import Syntax import Term -import Text.JSON -- | Render a diff to a string representing its JSON. -json :: Renderer a String -json diff (a, b) = encode . showJSON . fmap JSONWrapper . fmap (fmap JSONWrapper) . fst $ splitDiffByLines diff (0, 0) (source a, source b) +json :: ToJSON a => Renderer a ByteString +json diff (a, b) = encode $ splitDiffByLines diff (0, 0) (source a, source b) -newtype JSONWrapper a = JSONWrapper { unWrap :: a } - -instance JSON a => JSON (JSONWrapper (Row a)) where - showJSON (JSONWrapper (Row left right)) = JSObject $ toJSObject [("left", showJSON (JSONWrapper left)), ("right", showJSON (JSONWrapper right))] - -instance JSON a => JSON (JSONWrapper (Line a)) where - showJSON (JSONWrapper EmptyLine) = JSNull - showJSON (JSONWrapper (Line a)) = showJSONs (toList a) - -instance JSON (JSONWrapper Range) where - showJSON (JSONWrapper (Range start end)) = showJSON [ start, end ] - -instance JSON (JSONWrapper Info) where - showJSON (JSONWrapper (Info range categories)) = JSObject $ toJSObject [("range", showJSON (JSONWrapper range)), ("categories", showJSON (JSONWrapper <$> toList categories))] - -instance JSON (JSONWrapper Category) where - showJSON (JSONWrapper (Other s)) = JSString $ toJSString s - showJSON (JSONWrapper s) = JSString . toJSString $ show s - -instance JSON (JSONWrapper (SplitDiff a Info)) where - showJSON (JSONWrapper (Free (Annotated info syntax))) = JSObject $ toJSObject [("info", showJSON (JSONWrapper info)), ("syntax", showJSON (JSONWrapper $ JSONWrapper <$> syntax))] - showJSON (JSONWrapper (Pure patch)) = showJSON (JSONWrapper $ JSONWrapper <$> patch) - -instance JSON a => JSON (JSONWrapper (SplitPatch a)) where - showJSON (JSONWrapper (SplitInsert term)) = JSObject $ toJSObject [ ("insert", showJSON term) ] - showJSON (JSONWrapper (SplitDelete term)) = JSObject $ toJSObject [ ("delete", showJSON term) ] - showJSON (JSONWrapper (SplitReplace term)) = JSObject $ toJSObject [ ("replace", showJSON term) ] - -instance JSON (JSONWrapper (Term leaf Info)) where - showJSON (JSONWrapper (info :< syntax)) = JSObject $ toJSObject [("info", showJSON (JSONWrapper info)), ("syntax", showJSON (JSONWrapper $ JSONWrapper <$> syntax))] - -instance JSON recur => JSON (JSONWrapper (Syntax leaf recur)) where - showJSON (JSONWrapper (Leaf _)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "leaf") ] - showJSON (JSONWrapper (Indexed i)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "indexed"), ("children", showJSON i) ] - showJSON (JSONWrapper (Fixed i)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "fixed"), ("children", showJSON i) ] - showJSON (JSONWrapper (Keyed k)) = JSObject $ toJSObject [ ("type", JSString $ toJSString "fixed"), ("children", JSObject $ toJSObject ((\ (k, v) -> (show k, showJSON v)) <$> (Map.toList k))) ] +instance (ToJSON leaf, ToJSON annotation, ToJSON recur) => ToJSON (Annotated leaf annotation recur) +instance ToJSON Category +instance ToJSON Info +instance ToJSON a => ToJSON (Line a) +instance (ToJSON key, ToJSON value) => ToJSON (OrderedMap key value) +instance ToJSON Range +instance ToJSON a => ToJSON (Row a) +instance ToJSON leaf => ToJSON (SplitDiff leaf Info) +instance ToJSON a => ToJSON (SplitPatch a) +instance (ToJSON leaf, ToJSON recur) => ToJSON (Syntax leaf recur) +instance ToJSON leaf => ToJSON (Term leaf Info) diff --git a/test/CorpusSpec.hs b/test/CorpusSpec.hs index 1d277b771..fe556400b 100644 --- a/test/CorpusSpec.hs +++ b/test/CorpusSpec.hs @@ -9,7 +9,7 @@ import qualified Renderer.Split as Split import qualified Source as S import Control.DeepSeq import Data.Bifunctor.Join -import qualified Data.ByteString.Char8 as B1 +import qualified Data.ByteString.Lazy.Char8 as B import Data.List as List import Data.Map as Map import Data.Maybe @@ -38,13 +38,15 @@ spec = parallel $ do let tests = correctTests =<< paths mapM_ (\ (formatName, renderer, a, b, output) -> it (normalizeName a ++ " (" ++ formatName ++ ")") $ testDiff renderer a b output matcher) tests - correctTests :: (FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer a String, FilePath, FilePath, Maybe FilePath)] + correctTests :: (FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer T.Text String, FilePath, FilePath, Maybe FilePath)] correctTests paths@(_, _, Nothing, Nothing, Nothing) = testsForPaths paths correctTests paths = List.filter (\(_, _, _, _, output) -> isJust output) $ testsForPaths paths - testsForPaths :: (FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer a String, FilePath, FilePath, Maybe FilePath)] - testsForPaths (a, b, json, patch, split) = [ ("json", J.json, a, b, json), ("patch", P.patch, a, b, patch), ("split", testSplit, a, b, split) ] - testSplit :: Renderer a String + testsForPaths :: (FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer T.Text String, FilePath, FilePath, Maybe FilePath)] + testsForPaths (a, b, json, patch, split) = [ ("json", testJSON, a, b, json), ("patch", P.patch, a, b, patch), ("split", testSplit, a, b, split) ] + testSplit :: Renderer T.Text String testSplit diff sources = TL.unpack $ Split.split diff sources + testJSON :: Renderer T.Text String + testJSON diff sources = B.unpack $ J.json diff sources -- | Return all the examples from the given directory. Examples are expected to From e3ac671f1bdc587914120d5428e24e22be981369 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 20:53:36 -0500 Subject: [PATCH 077/149] Bump the fixtures. --- test/diffs/dictionary.json.js | 2 +- test/diffs/newline-at-eof.json.js | 2 +- test/diffs/no-newline-at-eof.json.js | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/diffs/dictionary.json.js b/test/diffs/dictionary.json.js index 9b78a419e..1f299a5c5 100644 --- a/test/diffs/dictionary.json.js +++ b/test/diffs/dictionary.json.js @@ -1 +1 @@ -[{"left":[{"info":{"range":[0,2],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,2],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,2],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{}}}]}}]}}],"right":[{"info":{"range":[0,2],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,2],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,2],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{}}}]}}]}}]},{"left":[{"info":{"range":[2,12],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[2,12],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[2,12],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{"\"\\\"b\\\"\"":{"info":{"range":[4,10],"categories":["Pair"]},"syntax":{"type":"fixed","children":[{"info":{"range":[4,7],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[4,5],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[5,6],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[6,7],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}},{"replace":{"info":{"range":[9,10],"categories":["number"]},"syntax":{"type":"leaf"}}}]}}}}}]}}]}}],"right":[{"info":{"range":[2,12],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[2,12],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[2,12],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{"\"\\\"b\\\"\"":{"info":{"range":[4,10],"categories":["Pair"]},"syntax":{"type":"fixed","children":[{"info":{"range":[4,7],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[4,5],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[5,6],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[6,7],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}},{"replace":{"info":{"range":[9,10],"categories":["number"]},"syntax":{"type":"leaf"}}}]}}}}}]}}]}}]},{"left":[{"info":{"range":[12,21],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,21],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,21],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{"\"\\\"a\\\"\"":{"info":{"range":[14,20],"categories":["Pair"]},"syntax":{"type":"fixed","children":[{"info":{"range":[14,17],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[14,15],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[15,16],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[16,17],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[19,20],"categories":["number"]},"syntax":{"type":"leaf"}}]}}}}}]}}]}}],"right":[{"info":{"range":[12,21],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,21],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,21],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{"\"\\\"a\\\"\"":{"info":{"range":[14,20],"categories":["Pair"]},"syntax":{"type":"fixed","children":[{"info":{"range":[14,17],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[14,15],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[15,16],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[16,17],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[19,20],"categories":["number"]},"syntax":{"type":"leaf"}}]}}}}}]}}]}}]},{"left":[{"info":{"range":[21,23],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[21,23],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[21,22],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{}}}]}}]}}],"right":[{"info":{"range":[21,23],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[21,23],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[21,22],"categories":["DictionaryLiteral"]},"syntax":{"type":"fixed","children":{}}}]}}]}}]},{"left":[{"info":{"range":[23,23],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[23,23],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[]}}]}}],"right":[{"info":{"range":[23,23],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[23,23],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[]}}]}}]}] \ No newline at end of file +[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":2}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":2}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"b\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":4,"end":5}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"b"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":5,"end":6}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":6,"end":7}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":4,"end":7}}}},{"tag":"Pure","contents":{"tag":"SplitReplace","contents":[{"categories":[{"tag":"Other","contents":"number"}],"characterRange":{"start":9,"end":10}},{"tag":"Leaf","contents":"4"}]}}]},"getAnnotation":{"categories":[{"tag":"Pair","contents":[]}],"characterRange":{"start":4,"end":10}}}}]]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":2,"end":12}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"b\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":4,"end":5}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"b"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":5,"end":6}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":6,"end":7}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":4,"end":7}}}},{"tag":"Pure","contents":{"tag":"SplitReplace","contents":[{"categories":[{"tag":"Other","contents":"number"}],"characterRange":{"start":9,"end":10}},{"tag":"Leaf","contents":"5"}]}}]},"getAnnotation":{"categories":[{"tag":"Pair","contents":[]}],"characterRange":{"start":4,"end":10}}}}]]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":2,"end":12}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"a\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":14,"end":15}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"a"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":15,"end":16}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":16,"end":17}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":14,"end":17}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"5"},"getAnnotation":{"categories":[{"tag":"Other","contents":"number"}],"characterRange":{"start":19,"end":20}}}}]},"getAnnotation":{"categories":[{"tag":"Pair","contents":[]}],"characterRange":{"start":14,"end":20}}}}]]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":12,"end":21}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"a\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":14,"end":15}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"a"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":15,"end":16}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":16,"end":17}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":14,"end":17}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"5"},"getAnnotation":{"categories":[{"tag":"Other","contents":"number"}],"characterRange":{"start":19,"end":20}}}}]},"getAnnotation":{"categories":[{"tag":"Pair","contents":[]}],"characterRange":{"start":14,"end":20}}}}]]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":12,"end":21}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":21,"end":22}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":21,"end":23}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":21,"end":23}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":21,"end":22}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":21,"end":23}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":21,"end":23}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":23,"end":23}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":23,"end":23}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":23,"end":23}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":23,"end":23}}}}]}}],[{"start":0,"end":23},{"start":0,"end":23}]] \ No newline at end of file diff --git a/test/diffs/newline-at-eof.json.js b/test/diffs/newline-at-eof.json.js index 16584186e..32dcc8e3c 100644 --- a/test/diffs/newline-at-eof.json.js +++ b/test/diffs/newline-at-eof.json.js @@ -1 +1 @@ -[{"left":[{"info":{"range":[0,29],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,28],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,27],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,11],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,7],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[8,11],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[12,26],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,26],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,13],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[13,18],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[18,19],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[20,25],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[25,26],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}]}}],"right":[{"info":{"range":[0,29],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,28],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,27],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,11],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,7],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[8,11],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[12,26],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,26],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,13],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[13,18],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[18,19],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[20,25],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[25,26],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}]}}]},{"left":null,"right":[{"info":{"range":[29,30],"categories":["program"]},"syntax":{"type":"indexed","children":[]}}]},{"left":null,"right":[{"info":{"range":[30,56],"categories":["program"]},"syntax":{"type":"indexed","children":[{"insert":{"info":{"range":[30,55],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,54],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,41],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,37],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[38,41],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[42,53],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[42,53],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[42,43],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[43,52],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[52,53],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}}]}}]},{"left":[{"info":{"range":[29,29],"categories":["program"]},"syntax":{"type":"indexed","children":[]}}],"right":[{"info":{"range":[56,56],"categories":["program"]},"syntax":{"type":"indexed","children":[]}}]}] \ No newline at end of file +[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":29}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":29}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":29,"end":30}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Pure","contents":{"tag":"SplitInsert","contents":[{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":30,"end":55}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":30,"end":54}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":30,"end":41}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":30,"end":37}},{"tag":"Leaf","contents":"console"}],[{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":38,"end":41}},{"tag":"Leaf","contents":"log"}]]}],[{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":42,"end":43}},{"tag":"Leaf","contents":"\""}],[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":43,"end":52}},{"tag":"Leaf","contents":"insertion"}],[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":52,"end":53}},{"tag":"Leaf","contents":"\""}]]}]]}]]}]]}]}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":30,"end":56}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":29,"end":29}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":56,"end":56}}}}]}}],[{"start":0,"end":29},{"start":0,"end":56}]] \ No newline at end of file diff --git a/test/diffs/no-newline-at-eof.json.js b/test/diffs/no-newline-at-eof.json.js index de56ec174..fc6e53dbe 100644 --- a/test/diffs/no-newline-at-eof.json.js +++ b/test/diffs/no-newline-at-eof.json.js @@ -1 +1 @@ -[{"left":[{"info":{"range":[0,28],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,28],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,27],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,11],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,7],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[8,11],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[12,26],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,26],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,13],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[13,18],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[18,19],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[20,25],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[25,26],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}]}}],"right":[{"info":{"range":[0,29],"categories":["program"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,28],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,27],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,11],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[0,7],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[8,11],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[12,26],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,26],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[12,13],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[13,18],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[18,19],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[20,25],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[25,26],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}]}}]},{"left":null,"right":[{"info":{"range":[29,30],"categories":["program"]},"syntax":{"type":"indexed","children":[]}}]},{"left":null,"right":[{"info":{"range":[30,55],"categories":["program"]},"syntax":{"type":"indexed","children":[{"insert":{"info":{"range":[30,55],"categories":["expression_statement"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,54],"categories":["FunctionCall"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,41],"categories":["member_access"]},"syntax":{"type":"indexed","children":[{"info":{"range":[30,37],"categories":["identifier"]},"syntax":{"type":"leaf"}},{"info":{"range":[38,41],"categories":["identifier"]},"syntax":{"type":"leaf"}}]}},{"info":{"range":[42,53],"categories":["arguments"]},"syntax":{"type":"indexed","children":[{"info":{"range":[42,53],"categories":["StringLiteral"]},"syntax":{"type":"indexed","children":[{"info":{"range":[42,43],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[43,52],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}},{"info":{"range":[52,53],"categories":["StringLiteral"]},"syntax":{"type":"leaf"}}]}}]}}]}}]}}}]}}]}] \ No newline at end of file +[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":28}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":29}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":29,"end":30}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Pure","contents":{"tag":"SplitInsert","contents":[{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":30,"end":55}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":30,"end":54}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":30,"end":41}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":30,"end":37}},{"tag":"Leaf","contents":"console"}],[{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":38,"end":41}},{"tag":"Leaf","contents":"log"}]]}],[{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":42,"end":43}},{"tag":"Leaf","contents":"\""}],[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":43,"end":52}},{"tag":"Leaf","contents":"insertion"}],[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":52,"end":53}},{"tag":"Leaf","contents":"\""}]]}]]}]]}]]}]}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":30,"end":55}}}}]}}],[{"start":0,"end":28},{"start":0,"end":55}]] \ No newline at end of file From d9006714d4167784635c985d7915d70cb120238a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 20:56:53 -0500 Subject: [PATCH 078/149] Disable orphan instance warnings in this module. --- src/Renderer/JSON.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 435f72f9b..362b8e9fe 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Renderer.JSON ( json ) where From e01b0c7df9c616fa946260cff0b159346abb7c6d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:21:24 -0500 Subject: [PATCH 079/149] Customize the Category instance. --- src/Renderer/JSON.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 362b8e9fe..5989ac164 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -9,6 +9,7 @@ import Category import Data.Aeson hiding (json) import Data.ByteString.Lazy import Data.OrderedMap +import qualified Data.Text as T import Diff import Line import Range @@ -24,7 +25,9 @@ json :: ToJSON a => Renderer a ByteString json diff (a, b) = encode $ splitDiffByLines diff (0, 0) (source a, source b) instance (ToJSON leaf, ToJSON annotation, ToJSON recur) => ToJSON (Annotated leaf annotation recur) -instance ToJSON Category +instance ToJSON Category where + toJSON (Other s) = String $ T.pack s + toJSON s = String . T.pack $ show s instance ToJSON Info instance ToJSON a => ToJSON (Line a) instance (ToJSON key, ToJSON value) => ToJSON (OrderedMap key value) From 65ee064cda12cd087970cb7542c09ce1e77b57ec Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:22:17 -0500 Subject: [PATCH 080/149] Bump the fixtures. --- test/diffs/dictionary.json.js | 2 +- test/diffs/newline-at-eof.json.js | 2 +- test/diffs/no-newline-at-eof.json.js | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/diffs/dictionary.json.js b/test/diffs/dictionary.json.js index 1f299a5c5..cbaeac526 100644 --- a/test/diffs/dictionary.json.js +++ b/test/diffs/dictionary.json.js @@ -1 +1 @@ -[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":2}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":2}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"b\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":4,"end":5}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"b"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":5,"end":6}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":6,"end":7}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":4,"end":7}}}},{"tag":"Pure","contents":{"tag":"SplitReplace","contents":[{"categories":[{"tag":"Other","contents":"number"}],"characterRange":{"start":9,"end":10}},{"tag":"Leaf","contents":"4"}]}}]},"getAnnotation":{"categories":[{"tag":"Pair","contents":[]}],"characterRange":{"start":4,"end":10}}}}]]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":2,"end":12}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"b\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":4,"end":5}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"b"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":5,"end":6}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":6,"end":7}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":4,"end":7}}}},{"tag":"Pure","contents":{"tag":"SplitReplace","contents":[{"categories":[{"tag":"Other","contents":"number"}],"characterRange":{"start":9,"end":10}},{"tag":"Leaf","contents":"5"}]}}]},"getAnnotation":{"categories":[{"tag":"Pair","contents":[]}],"characterRange":{"start":4,"end":10}}}}]]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":2,"end":12}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"a\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":14,"end":15}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"a"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":15,"end":16}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":16,"end":17}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":14,"end":17}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"5"},"getAnnotation":{"categories":[{"tag":"Other","contents":"number"}],"characterRange":{"start":19,"end":20}}}}]},"getAnnotation":{"categories":[{"tag":"Pair","contents":[]}],"characterRange":{"start":14,"end":20}}}}]]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":12,"end":21}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"a\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":14,"end":15}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"a"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":15,"end":16}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":16,"end":17}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":14,"end":17}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"5"},"getAnnotation":{"categories":[{"tag":"Other","contents":"number"}],"characterRange":{"start":19,"end":20}}}}]},"getAnnotation":{"categories":[{"tag":"Pair","contents":[]}],"characterRange":{"start":14,"end":20}}}}]]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":12,"end":21}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":21,"end":22}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":21,"end":23}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":21,"end":23}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":[{"tag":"DictionaryLiteral","contents":[]}],"characterRange":{"start":21,"end":22}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":21,"end":23}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":21,"end":23}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":23,"end":23}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":23,"end":23}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":23,"end":23}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":23,"end":23}}}}]}}],[{"start":0,"end":23},{"start":0,"end":23}]] \ No newline at end of file +[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":2}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":2}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"b\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":4,"end":5}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"b"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":5,"end":6}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":6,"end":7}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":4,"end":7}}}},{"tag":"Pure","contents":{"tag":"SplitReplace","contents":[{"categories":["number"],"characterRange":{"start":9,"end":10}},{"tag":"Leaf","contents":"4"}]}}]},"getAnnotation":{"categories":["Pair"],"characterRange":{"start":4,"end":10}}}}]]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":2,"end":12}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"b\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":4,"end":5}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"b"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":5,"end":6}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":6,"end":7}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":4,"end":7}}}},{"tag":"Pure","contents":{"tag":"SplitReplace","contents":[{"categories":["number"],"characterRange":{"start":9,"end":10}},{"tag":"Leaf","contents":"5"}]}}]},"getAnnotation":{"categories":["Pair"],"characterRange":{"start":4,"end":10}}}}]]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":2,"end":12}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"a\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":14,"end":15}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"a"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":15,"end":16}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":16,"end":17}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":14,"end":17}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"5"},"getAnnotation":{"categories":["number"],"characterRange":{"start":19,"end":20}}}}]},"getAnnotation":{"categories":["Pair"],"characterRange":{"start":14,"end":20}}}}]]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":12,"end":21}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"a\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":14,"end":15}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"a"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":15,"end":16}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":16,"end":17}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":14,"end":17}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"5"},"getAnnotation":{"categories":["number"],"characterRange":{"start":19,"end":20}}}}]},"getAnnotation":{"categories":["Pair"],"characterRange":{"start":14,"end":20}}}}]]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":12,"end":21}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":21,"end":22}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":21,"end":23}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":21,"end":23}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":21,"end":22}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":21,"end":23}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":21,"end":23}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":23,"end":23}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":23,"end":23}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":23,"end":23}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":23,"end":23}}}}]}}],[{"start":0,"end":23},{"start":0,"end":23}]] \ No newline at end of file diff --git a/test/diffs/newline-at-eof.json.js b/test/diffs/newline-at-eof.json.js index 32dcc8e3c..5dfcd335e 100644 --- a/test/diffs/newline-at-eof.json.js +++ b/test/diffs/newline-at-eof.json.js @@ -1 +1 @@ -[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":29}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":29}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":29,"end":30}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Pure","contents":{"tag":"SplitInsert","contents":[{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":30,"end":55}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":30,"end":54}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":30,"end":41}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":30,"end":37}},{"tag":"Leaf","contents":"console"}],[{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":38,"end":41}},{"tag":"Leaf","contents":"log"}]]}],[{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":42,"end":43}},{"tag":"Leaf","contents":"\""}],[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":43,"end":52}},{"tag":"Leaf","contents":"insertion"}],[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":52,"end":53}},{"tag":"Leaf","contents":"\""}]]}]]}]]}]]}]}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":30,"end":56}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":29,"end":29}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":56,"end":56}}}}]}}],[{"start":0,"end":29},{"start":0,"end":56}]] \ No newline at end of file +[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":["member_access"],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["arguments"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["FunctionCall"],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":29}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":["member_access"],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["arguments"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["FunctionCall"],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":29}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["program"],"characterRange":{"start":29,"end":30}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Pure","contents":{"tag":"SplitInsert","contents":[{"categories":["expression_statement"],"characterRange":{"start":30,"end":55}},{"tag":"Indexed","contents":[[{"categories":["FunctionCall"],"characterRange":{"start":30,"end":54}},{"tag":"Indexed","contents":[[{"categories":["member_access"],"characterRange":{"start":30,"end":41}},{"tag":"Indexed","contents":[[{"categories":["identifier"],"characterRange":{"start":30,"end":37}},{"tag":"Leaf","contents":"console"}],[{"categories":["identifier"],"characterRange":{"start":38,"end":41}},{"tag":"Leaf","contents":"log"}]]}],[{"categories":["arguments"],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":["StringLiteral"],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":["StringLiteral"],"characterRange":{"start":42,"end":43}},{"tag":"Leaf","contents":"\""}],[{"categories":["StringLiteral"],"characterRange":{"start":43,"end":52}},{"tag":"Leaf","contents":"insertion"}],[{"categories":["StringLiteral"],"characterRange":{"start":52,"end":53}},{"tag":"Leaf","contents":"\""}]]}]]}]]}]]}]}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":30,"end":56}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["program"],"characterRange":{"start":29,"end":29}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["program"],"characterRange":{"start":56,"end":56}}}}]}}],[{"start":0,"end":29},{"start":0,"end":56}]] \ No newline at end of file diff --git a/test/diffs/no-newline-at-eof.json.js b/test/diffs/no-newline-at-eof.json.js index fc6e53dbe..71257739a 100644 --- a/test/diffs/no-newline-at-eof.json.js +++ b/test/diffs/no-newline-at-eof.json.js @@ -1 +1 @@ -[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":28}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":0,"end":29}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":29,"end":30}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Pure","contents":{"tag":"SplitInsert","contents":[{"categories":[{"tag":"Other","contents":"expression_statement"}],"characterRange":{"start":30,"end":55}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"FunctionCall","contents":[]}],"characterRange":{"start":30,"end":54}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"Other","contents":"member_access"}],"characterRange":{"start":30,"end":41}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":30,"end":37}},{"tag":"Leaf","contents":"console"}],[{"categories":[{"tag":"Other","contents":"identifier"}],"characterRange":{"start":38,"end":41}},{"tag":"Leaf","contents":"log"}]]}],[{"categories":[{"tag":"Other","contents":"arguments"}],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":42,"end":43}},{"tag":"Leaf","contents":"\""}],[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":43,"end":52}},{"tag":"Leaf","contents":"insertion"}],[{"categories":[{"tag":"StringLiteral","contents":[]}],"characterRange":{"start":52,"end":53}},{"tag":"Leaf","contents":"\""}]]}]]}]]}]]}]}}]},"getAnnotation":{"categories":[{"tag":"Other","contents":"program"}],"characterRange":{"start":30,"end":55}}}}]}}],[{"start":0,"end":28},{"start":0,"end":55}]] \ No newline at end of file +[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":["member_access"],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["arguments"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["FunctionCall"],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":28}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":["member_access"],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["arguments"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["FunctionCall"],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":29}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["program"],"characterRange":{"start":29,"end":30}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Pure","contents":{"tag":"SplitInsert","contents":[{"categories":["expression_statement"],"characterRange":{"start":30,"end":55}},{"tag":"Indexed","contents":[[{"categories":["FunctionCall"],"characterRange":{"start":30,"end":54}},{"tag":"Indexed","contents":[[{"categories":["member_access"],"characterRange":{"start":30,"end":41}},{"tag":"Indexed","contents":[[{"categories":["identifier"],"characterRange":{"start":30,"end":37}},{"tag":"Leaf","contents":"console"}],[{"categories":["identifier"],"characterRange":{"start":38,"end":41}},{"tag":"Leaf","contents":"log"}]]}],[{"categories":["arguments"],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":["StringLiteral"],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":["StringLiteral"],"characterRange":{"start":42,"end":43}},{"tag":"Leaf","contents":"\""}],[{"categories":["StringLiteral"],"characterRange":{"start":43,"end":52}},{"tag":"Leaf","contents":"insertion"}],[{"categories":["StringLiteral"],"characterRange":{"start":52,"end":53}},{"tag":"Leaf","contents":"\""}]]}]]}]]}]]}]}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":30,"end":55}}}}]}}],[{"start":0,"end":28},{"start":0,"end":55}]] \ No newline at end of file From c836faa1cf95a16fbcad748fdf8620709fde3206 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:33:03 -0500 Subject: [PATCH 081/149] Encode Syntax manually. --- src/Renderer/JSON.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 5989ac164..dfc49f64d 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Renderer.JSON ( json @@ -8,14 +8,15 @@ import Alignment import Category import Data.Aeson hiding (json) import Data.ByteString.Lazy -import Data.OrderedMap +import Data.OrderedMap hiding (fromList) import qualified Data.Text as T +import Data.Vector hiding (toList) import Diff import Line import Range import Renderer import Row -import Source +import Source hiding (fromList, toList) import SplitDiff import Syntax import Term @@ -30,10 +31,13 @@ instance ToJSON Category where toJSON s = String . T.pack $ show s instance ToJSON Info instance ToJSON a => ToJSON (Line a) -instance (ToJSON key, ToJSON value) => ToJSON (OrderedMap key value) instance ToJSON Range instance ToJSON a => ToJSON (Row a) instance ToJSON leaf => ToJSON (SplitDiff leaf Info) instance ToJSON a => ToJSON (SplitPatch a) -instance (ToJSON leaf, ToJSON recur) => ToJSON (Syntax leaf recur) +instance (ToJSON leaf, ToJSON recur) => ToJSON (Syntax leaf recur) where + toJSON (Leaf _) = object [ "type" .= String "leaf" ] + toJSON (Indexed c) = object [ "type" .= String "indexed", "children" .= Array (fromList $ toJSON <$> c) ] + toJSON (Fixed c) = object [ "type" .= String "fixed", "children" .= Array (fromList $ toJSON <$> c) ] + toJSON (Keyed c) = object [ "type" .= String "fixed", "children" .= object (uncurry (.=) <$> toList c) ] instance ToJSON leaf => ToJSON (Term leaf Info) From 621f727a7901a975d5755f61bce9710e4874b458 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:35:03 -0500 Subject: [PATCH 082/149] Encode SplitPatch manually. --- src/Renderer/JSON.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index dfc49f64d..3251a46cc 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -34,7 +34,10 @@ instance ToJSON a => ToJSON (Line a) instance ToJSON Range instance ToJSON a => ToJSON (Row a) instance ToJSON leaf => ToJSON (SplitDiff leaf Info) -instance ToJSON a => ToJSON (SplitPatch a) +instance ToJSON a => ToJSON (SplitPatch a) where + toJSON (SplitInsert a) = object [ "insert" .= toJSON a ] + toJSON (SplitDelete a) = object [ "delete" .= toJSON a ] + toJSON (SplitReplace a) = object [ "replace" .= toJSON a ] instance (ToJSON leaf, ToJSON recur) => ToJSON (Syntax leaf recur) where toJSON (Leaf _) = object [ "type" .= String "leaf" ] toJSON (Indexed c) = object [ "type" .= String "indexed", "children" .= Array (fromList $ toJSON <$> c) ] From 4d9fc06a53b9a015f33a12a6ed22aab5ef7addca Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:36:17 -0500 Subject: [PATCH 083/149] Encode Range manually. --- src/Renderer/JSON.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 3251a46cc..c287e82fe 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -31,7 +31,8 @@ instance ToJSON Category where toJSON s = String . T.pack $ show s instance ToJSON Info instance ToJSON a => ToJSON (Line a) -instance ToJSON Range +instance ToJSON Range where + toJSON (Range start end) = Array (fromList [ toJSON start, toJSON end ]) instance ToJSON a => ToJSON (Row a) instance ToJSON leaf => ToJSON (SplitDiff leaf Info) instance ToJSON a => ToJSON (SplitPatch a) where From 2edada29c7928975a26f11699d10310e1dcc55bd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:38:46 -0500 Subject: [PATCH 084/149] Shallower encoding of Term. --- src/Renderer/JSON.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index c287e82fe..60db7de12 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -6,6 +6,7 @@ module Renderer.JSON ( import Alignment import Category +import Control.Comonad.Cofree import Data.Aeson hiding (json) import Data.ByteString.Lazy import Data.OrderedMap hiding (fromList) @@ -44,4 +45,5 @@ instance (ToJSON leaf, ToJSON recur) => ToJSON (Syntax leaf recur) where toJSON (Indexed c) = object [ "type" .= String "indexed", "children" .= Array (fromList $ toJSON <$> c) ] toJSON (Fixed c) = object [ "type" .= String "fixed", "children" .= Array (fromList $ toJSON <$> c) ] toJSON (Keyed c) = object [ "type" .= String "fixed", "children" .= object (uncurry (.=) <$> toList c) ] -instance ToJSON leaf => ToJSON (Term leaf Info) +instance ToJSON leaf => ToJSON (Term leaf Info) where + toJSON (Info range categories :< syntax) = object [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] From b6eefc23aecc49fca4ab0aa4a993ff03dcb8efbb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:41:16 -0500 Subject: [PATCH 085/149] Shallower encoding of SplitDiff. --- src/Renderer/JSON.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 60db7de12..912747a59 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -7,6 +7,7 @@ module Renderer.JSON ( import Alignment import Category import Control.Comonad.Cofree +import Control.Monad.Free import Data.Aeson hiding (json) import Data.ByteString.Lazy import Data.OrderedMap hiding (fromList) @@ -35,7 +36,9 @@ instance ToJSON a => ToJSON (Line a) instance ToJSON Range where toJSON (Range start end) = Array (fromList [ toJSON start, toJSON end ]) instance ToJSON a => ToJSON (Row a) -instance ToJSON leaf => ToJSON (SplitDiff leaf Info) +instance ToJSON leaf => ToJSON (SplitDiff leaf Info) where + toJSON (Free (Annotated (Info range categories) syntax)) = object [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] + toJSON (Pure patch) = toJSON patch instance ToJSON a => ToJSON (SplitPatch a) where toJSON (SplitInsert a) = object [ "insert" .= toJSON a ] toJSON (SplitDelete a) = object [ "delete" .= toJSON a ] From 7c8041ad8ef3248b57672db3831792eba8159e8e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:41:47 -0500 Subject: [PATCH 086/149] Remove the instance for Info. --- src/Renderer/JSON.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 912747a59..fe8cbb940 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -31,7 +31,6 @@ instance (ToJSON leaf, ToJSON annotation, ToJSON recur) => ToJSON (Annotated lea instance ToJSON Category where toJSON (Other s) = String $ T.pack s toJSON s = String . T.pack $ show s -instance ToJSON Info instance ToJSON a => ToJSON (Line a) instance ToJSON Range where toJSON (Range start end) = Array (fromList [ toJSON start, toJSON end ]) From 12dd698f61c00aaef7d933f58cab600c6cc5119b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:44:27 -0500 Subject: [PATCH 087/149] =?UTF-8?q?Don=E2=80=99t=20encode=20the=20overall?= =?UTF-8?q?=20range.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index fe8cbb940..12c45e8be 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -25,7 +25,7 @@ import Term -- | Render a diff to a string representing its JSON. json :: ToJSON a => Renderer a ByteString -json diff (a, b) = encode $ splitDiffByLines diff (0, 0) (source a, source b) +json diff (a, b) = encode . fst $ splitDiffByLines diff (0, 0) (source a, source b) instance (ToJSON leaf, ToJSON annotation, ToJSON recur) => ToJSON (Annotated leaf annotation recur) instance ToJSON Category where From 1515240e8ec56f6730978d76e96372c854df128d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:44:31 -0500 Subject: [PATCH 088/149] Flatter encoding of Row. --- src/Renderer/JSON.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 12c45e8be..b5fbbd8fa 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -34,7 +34,8 @@ instance ToJSON Category where instance ToJSON a => ToJSON (Line a) instance ToJSON Range where toJSON (Range start end) = Array (fromList [ toJSON start, toJSON end ]) -instance ToJSON a => ToJSON (Row a) +instance ToJSON a => ToJSON (Row a) where + toJSON (Row left right) = object [ "left" .= toJSON (fromList $ unLine left), "right" .= toJSON (fromList $ unLine right) ] instance ToJSON leaf => ToJSON (SplitDiff leaf Info) where toJSON (Free (Annotated (Info range categories) syntax)) = object [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] toJSON (Pure patch) = toJSON patch From 2ec4d3efb52707ebdf31b5ee8472da32494c61f4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:44:49 -0500 Subject: [PATCH 089/149] Remove the instance for Line. --- src/Renderer/JSON.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index b5fbbd8fa..cfafdbb19 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -31,7 +31,6 @@ instance (ToJSON leaf, ToJSON annotation, ToJSON recur) => ToJSON (Annotated lea instance ToJSON Category where toJSON (Other s) = String $ T.pack s toJSON s = String . T.pack $ show s -instance ToJSON a => ToJSON (Line a) instance ToJSON Range where toJSON (Range start end) = Array (fromList [ toJSON start, toJSON end ]) instance ToJSON a => ToJSON (Row a) where From 9260faf3afcd03623fa9efa4fdc0a20b7e273915 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:46:30 -0500 Subject: [PATCH 090/149] Update the fixtures. --- test/diffs/dictionary.json.js | 2 +- test/diffs/newline-at-eof.json.js | 2 +- test/diffs/no-newline-at-eof.json.js | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/diffs/dictionary.json.js b/test/diffs/dictionary.json.js index cbaeac526..746932d9e 100644 --- a/test/diffs/dictionary.json.js +++ b/test/diffs/dictionary.json.js @@ -1 +1 @@ -[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":2}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":2}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":2}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"b\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":4,"end":5}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"b"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":5,"end":6}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":6,"end":7}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":4,"end":7}}}},{"tag":"Pure","contents":{"tag":"SplitReplace","contents":[{"categories":["number"],"characterRange":{"start":9,"end":10}},{"tag":"Leaf","contents":"4"}]}}]},"getAnnotation":{"categories":["Pair"],"characterRange":{"start":4,"end":10}}}}]]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":2,"end":12}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"b\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":4,"end":5}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"b"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":5,"end":6}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":6,"end":7}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":4,"end":7}}}},{"tag":"Pure","contents":{"tag":"SplitReplace","contents":[{"categories":["number"],"characterRange":{"start":9,"end":10}},{"tag":"Leaf","contents":"5"}]}}]},"getAnnotation":{"categories":["Pair"],"characterRange":{"start":4,"end":10}}}}]]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":2,"end":12}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":2,"end":12}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"a\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":14,"end":15}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"a"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":15,"end":16}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":16,"end":17}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":14,"end":17}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"5"},"getAnnotation":{"categories":["number"],"characterRange":{"start":19,"end":20}}}}]},"getAnnotation":{"categories":["Pair"],"characterRange":{"start":14,"end":20}}}}]]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":12,"end":21}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[["\"a\"",{"tag":"Free","contents":{"getSyntax":{"tag":"Fixed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":14,"end":15}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"a"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":15,"end":16}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":16,"end":17}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":14,"end":17}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"5"},"getAnnotation":{"categories":["number"],"characterRange":{"start":19,"end":20}}}}]},"getAnnotation":{"categories":["Pair"],"characterRange":{"start":14,"end":20}}}}]]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":12,"end":21}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":12,"end":21}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":21,"end":22}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":21,"end":23}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":21,"end":23}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Keyed","contents":{"toList":[]}},"getAnnotation":{"categories":["DictionaryLiteral"],"characterRange":{"start":21,"end":22}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":21,"end":23}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":21,"end":23}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":23,"end":23}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":23,"end":23}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":23,"end":23}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":23,"end":23}}}}]}}],[{"start":0,"end":23},{"start":0,"end":23}]] \ No newline at end of file +[{"left":[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}]}] \ No newline at end of file diff --git a/test/diffs/newline-at-eof.json.js b/test/diffs/newline-at-eof.json.js index 5dfcd335e..81c1b5c01 100644 --- a/test/diffs/newline-at-eof.json.js +++ b/test/diffs/newline-at-eof.json.js @@ -1 +1 @@ -[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":["member_access"],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["arguments"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["FunctionCall"],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":29}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":["member_access"],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["arguments"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["FunctionCall"],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":29}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["program"],"characterRange":{"start":29,"end":30}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Pure","contents":{"tag":"SplitInsert","contents":[{"categories":["expression_statement"],"characterRange":{"start":30,"end":55}},{"tag":"Indexed","contents":[[{"categories":["FunctionCall"],"characterRange":{"start":30,"end":54}},{"tag":"Indexed","contents":[[{"categories":["member_access"],"characterRange":{"start":30,"end":41}},{"tag":"Indexed","contents":[[{"categories":["identifier"],"characterRange":{"start":30,"end":37}},{"tag":"Leaf","contents":"console"}],[{"categories":["identifier"],"characterRange":{"start":38,"end":41}},{"tag":"Leaf","contents":"log"}]]}],[{"categories":["arguments"],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":["StringLiteral"],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":["StringLiteral"],"characterRange":{"start":42,"end":43}},{"tag":"Leaf","contents":"\""}],[{"categories":["StringLiteral"],"characterRange":{"start":43,"end":52}},{"tag":"Leaf","contents":"insertion"}],[{"categories":["StringLiteral"],"characterRange":{"start":52,"end":53}},{"tag":"Leaf","contents":"\""}]]}]]}]]}]]}]}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":30,"end":56}}}}]}},{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["program"],"characterRange":{"start":29,"end":29}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["program"],"characterRange":{"start":56,"end":56}}}}]}}],[{"start":0,"end":29},{"start":0,"end":56}]] \ No newline at end of file +[{"left":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[30,56],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[29,29],"syntax":{"children":[],"type":"indexed"}}],"right":[{"categories":["program"],"range":[56,56],"syntax":{"children":[],"type":"indexed"}}]}] \ No newline at end of file diff --git a/test/diffs/no-newline-at-eof.json.js b/test/diffs/no-newline-at-eof.json.js index 71257739a..cbd40a8fc 100644 --- a/test/diffs/no-newline-at-eof.json.js +++ b/test/diffs/no-newline-at-eof.json.js @@ -1 +1 @@ -[[{"unLeft":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":["member_access"],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["arguments"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["FunctionCall"],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":28}}}}]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"console"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":0,"end":7}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"log"},"getAnnotation":{"categories":["identifier"],"characterRange":{"start":8,"end":11}}}}]},"getAnnotation":{"categories":["member_access"],"characterRange":{"start":0,"end":11}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":13}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"hello"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":13,"end":18}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":","},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":18,"end":19}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"world"},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":20,"end":25}}}},{"tag":"Free","contents":{"getSyntax":{"tag":"Leaf","contents":"\""},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":25,"end":26}}}}]},"getAnnotation":{"categories":["StringLiteral"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["arguments"],"characterRange":{"start":12,"end":26}}}}]},"getAnnotation":{"categories":["FunctionCall"],"characterRange":{"start":0,"end":27}}}}]},"getAnnotation":{"categories":["expression_statement"],"characterRange":{"start":0,"end":28}}}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":0,"end":29}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[]},"getAnnotation":{"categories":["program"],"characterRange":{"start":29,"end":30}}}}]}},{"unLeft":{"tag":"EmptyLine","contents":[]},"unRight":{"tag":"Line","contents":[{"tag":"Free","contents":{"getSyntax":{"tag":"Indexed","contents":[{"tag":"Pure","contents":{"tag":"SplitInsert","contents":[{"categories":["expression_statement"],"characterRange":{"start":30,"end":55}},{"tag":"Indexed","contents":[[{"categories":["FunctionCall"],"characterRange":{"start":30,"end":54}},{"tag":"Indexed","contents":[[{"categories":["member_access"],"characterRange":{"start":30,"end":41}},{"tag":"Indexed","contents":[[{"categories":["identifier"],"characterRange":{"start":30,"end":37}},{"tag":"Leaf","contents":"console"}],[{"categories":["identifier"],"characterRange":{"start":38,"end":41}},{"tag":"Leaf","contents":"log"}]]}],[{"categories":["arguments"],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":["StringLiteral"],"characterRange":{"start":42,"end":53}},{"tag":"Indexed","contents":[[{"categories":["StringLiteral"],"characterRange":{"start":42,"end":43}},{"tag":"Leaf","contents":"\""}],[{"categories":["StringLiteral"],"characterRange":{"start":43,"end":52}},{"tag":"Leaf","contents":"insertion"}],[{"categories":["StringLiteral"],"characterRange":{"start":52,"end":53}},{"tag":"Leaf","contents":"\""}]]}]]}]]}]]}]}}]},"getAnnotation":{"categories":["program"],"characterRange":{"start":30,"end":55}}}}]}}],[{"start":0,"end":28},{"start":0,"end":55}]] \ No newline at end of file +[{"left":[{"categories":["program"],"range":[0,28],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[30,55],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]}] \ No newline at end of file From 32f745ed3a74ff310df214ba2aae25bb0b906a71 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:48:49 -0500 Subject: [PATCH 091/149] Remove the instance for Annotated. --- src/Renderer/JSON.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index cfafdbb19..aa4bc68ff 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -27,7 +27,6 @@ import Term json :: ToJSON a => Renderer a ByteString json diff (a, b) = encode . fst $ splitDiffByLines diff (0, 0) (source a, source b) -instance (ToJSON leaf, ToJSON annotation, ToJSON recur) => ToJSON (Annotated leaf annotation recur) instance ToJSON Category where toJSON (Other s) = String $ T.pack s toJSON s = String . T.pack $ show s From 897e8255b46806465d84c6b9fb1496e09d84fa44 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:48:58 -0500 Subject: [PATCH 092/149] Revert "Generic instances everywhere, why not." This reverts commit 82105fde6f9ccd06042d0f7ada88b2d0ee072069. --- src/Category.hs | 5 ++--- src/Control/Comonad/Cofree.hs | 4 +--- src/Control/Monad/Free.hs | 4 +--- src/Data/OrderedMap.hs | 3 +-- src/Diff.hs | 15 +++++++-------- src/Line.hs | 3 +-- src/Range.hs | 5 ++--- src/Row.hs | 3 +-- src/Source.hs | 4 ++-- src/SplitDiff.hs | 3 +-- src/Syntax.hs | 3 +-- 11 files changed, 20 insertions(+), 32 deletions(-) diff --git a/src/Category.hs b/src/Category.hs index 5cf370543..f90ee8a12 100644 --- a/src/Category.hs +++ b/src/Category.hs @@ -1,10 +1,9 @@ {-# LANGUAGE FlexibleInstances #-} module Category where +import Term import Control.Comonad.Cofree import Data.Set -import GHC.Generics -import Term -- | A standardized category of AST node. Used to determine the semantics for -- | semantic diffing and define comparability of nodes. @@ -25,7 +24,7 @@ data Category = | SymbolLiteral -- | A non-standard category, which can be used for comparability. | Other String - deriving (Eq, Ord, Generic, Show) + deriving (Eq, Show, Ord) -- | The class of types that have categories. class Categorizable a where diff --git a/src/Control/Comonad/Cofree.hs b/src/Control/Comonad/Cofree.hs index b1129745d..bf80577e6 100644 --- a/src/Control/Comonad/Cofree.hs +++ b/src/Control/Comonad/Cofree.hs @@ -1,10 +1,8 @@ {-# LANGUAGE UndecidableInstances #-} module Control.Comonad.Cofree where -import GHC.Generics - data Cofree functor annotation = annotation :< (functor (Cofree functor annotation)) - deriving (Functor, Foldable, Generic, Traversable) + deriving (Functor, Foldable, Traversable) instance (Eq annotation, Eq (functor (Cofree functor annotation))) => Eq (Cofree functor annotation) where a :< f == b :< g = a == b && f == g diff --git a/src/Control/Monad/Free.hs b/src/Control/Monad/Free.hs index 1c33f82d1..4c7a1271c 100644 --- a/src/Control/Monad/Free.hs +++ b/src/Control/Monad/Free.hs @@ -1,10 +1,8 @@ {-# LANGUAGE UndecidableInstances #-} module Control.Monad.Free where -import GHC.Generics - data Free functor pure = Free (functor (Free functor pure)) | Pure pure - deriving (Functor, Foldable, Generic, Traversable) + deriving (Functor, Foldable, Traversable) instance (Eq pure, Eq (functor (Free functor pure))) => Eq (Free functor pure) where Pure a == Pure b = a == b diff --git a/src/Data/OrderedMap.hs b/src/Data/OrderedMap.hs index 759b47dc6..345a5b7df 100644 --- a/src/Data/OrderedMap.hs +++ b/src/Data/OrderedMap.hs @@ -14,11 +14,10 @@ module Data.OrderedMap ( ) where import qualified Data.Maybe as Maybe -import GHC.Generics -- | An ordered map of keys and values. data OrderedMap key value = OrderedMap { toList :: [(key, value)] } - deriving (Eq, Foldable, Functor, Generic, Show, Traversable) + deriving (Show, Eq, Functor, Foldable, Traversable) instance Eq key => Monoid (OrderedMap key value) where mempty = fromList [] diff --git a/src/Diff.hs b/src/Diff.hs index 6fd729876..85d20a344 100644 --- a/src/Diff.hs +++ b/src/Diff.hs @@ -1,22 +1,21 @@ module Diff where -import Category -import Control.Monad.Free -import Data.Set -import GHC.Generics -import Patch -import Range import Syntax +import Data.Set +import Control.Monad.Free +import Patch import Term +import Range +import Category -- | An annotated syntax in a diff tree. data Annotated a annotation f = Annotated { getAnnotation :: !annotation, getSyntax :: !(Syntax a f) } - deriving (Foldable, Functor, Generic, Eq, Show, Traversable) + deriving (Functor, Eq, Show, Foldable) -- | An annotation for a source file, including the source range and semantic -- | categories. data Info = Info { characterRange :: !Range, categories :: !(Set Category) } - deriving (Eq, Generic, Show) + deriving (Eq, Show) instance Categorizable Info where categories = Diff.categories diff --git a/src/Line.hs b/src/Line.hs index b738977a9..05d2336d9 100644 --- a/src/Line.hs +++ b/src/Line.hs @@ -4,7 +4,6 @@ module Line where import qualified Data.Foldable as Foldable import Data.Monoid import qualified Data.Vector as Vector -import GHC.Generics import Text.Blaze.Html5 hiding (map) import qualified Text.Blaze.Html5.Attributes as A @@ -12,7 +11,7 @@ import qualified Text.Blaze.Html5.Attributes as A data Line a = Line (Vector.Vector a) | EmptyLine - deriving (Eq, Foldable, Functor, Generic, Traversable) + deriving (Eq, Functor, Foldable) -- | Create a line from a list of items. makeLine :: [a] -> Line a diff --git a/src/Range.hs b/src/Range.hs index 0c2b6e26c..8b5408a84 100644 --- a/src/Range.hs +++ b/src/Range.hs @@ -1,16 +1,15 @@ {-# LANGUAGE FlexibleInstances #-} module Range where +import qualified Data.Text as T import Control.Applicative ((<|>)) import qualified Data.Char as Char import Data.Maybe (fromMaybe) import Data.Option -import qualified Data.Text as T -import GHC.Generics -- | A half-open interval of integers, defined by start & end indices. data Range = Range { start :: !Int, end :: !Int } - deriving (Eq, Show, Generic) + deriving (Eq, Show) -- | Return the length of the range. rangeLength :: Range -> Int diff --git a/src/Row.hs b/src/Row.hs index 789bc4b28..c4ac66895 100644 --- a/src/Row.hs +++ b/src/Row.hs @@ -1,12 +1,11 @@ module Row where import Control.Arrow -import GHC.Generics import Line -- | A row in a split diff, composed of a before line and an after line. data Row a = Row { unLeft :: !(Line a), unRight :: !(Line a) } - deriving (Eq, Foldable, Functor, Generic, Traversable) + deriving (Eq, Functor) -- | Return a tuple of lines from the row. unRow :: Row a -> (Line a, Line a) diff --git a/src/Source.hs b/src/Source.hs index 117b08e5f..070c8621a 100644 --- a/src/Source.hs +++ b/src/Source.hs @@ -1,8 +1,8 @@ module Source where -import qualified Data.Text as T -import qualified Data.Vector as Vector import Range +import qualified Data.Vector as Vector +import qualified Data.Text as T data SourceBlob = SourceBlob { source :: Source Char, oid :: String, path :: FilePath } diff --git a/src/SplitDiff.hs b/src/SplitDiff.hs index 2696431ab..5b4ea0a94 100644 --- a/src/SplitDiff.hs +++ b/src/SplitDiff.hs @@ -1,13 +1,12 @@ module SplitDiff where -import GHC.Generics import Diff (Annotated) import Control.Monad.Free (Free) import Term (Term) -- | A patch to only one side of a diff. data SplitPatch a = SplitInsert a | SplitDelete a | SplitReplace a - deriving (Show, Eq, Functor, Generic) + deriving (Show, Eq, Functor) -- | Get the term from a split patch. getSplitTerm :: SplitPatch a -> a diff --git a/src/Syntax.hs b/src/Syntax.hs index f37b985a7..6c35d2d5b 100644 --- a/src/Syntax.hs +++ b/src/Syntax.hs @@ -2,7 +2,6 @@ module Syntax where import Data.OrderedMap import qualified Data.Text as T -import GHC.Generics -- | A node in an abstract syntax tree. data Syntax @@ -17,4 +16,4 @@ data Syntax | Fixed [f] -- | A branch of child nodes indexed by some String identity. This is useful for identifying e.g. methods & properties in a class scope by their names. Note that comments can generally occur in these scopes as well; one strategy for dealing with this is to identify comments by their text in the source. | Keyed (OrderedMap T.Text f) - deriving (Eq, Foldable, Functor, Generic, Show, Traversable) + deriving (Functor, Show, Eq, Foldable, Traversable) From 71c908c7b7e84389b750b3ea1c152375c73b5eff Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:53:26 -0500 Subject: [PATCH 093/149] Place the rows into a top-level object. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index aa4bc68ff..2b5f4240b 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -25,7 +25,7 @@ import Term -- | Render a diff to a string representing its JSON. json :: ToJSON a => Renderer a ByteString -json diff (a, b) = encode . fst $ splitDiffByLines diff (0, 0) (source a, source b) +json diff (a, b) = encode $ object [ "rows" .= fst (splitDiffByLines diff (0, 0) (source a, source b)) ] instance ToJSON Category where toJSON (Other s) = String $ T.pack s From 8e5bb19ec23de912dfddd5fff05ec93c3d04df9e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 21:53:38 -0500 Subject: [PATCH 094/149] More fixture bumping. --- test/diffs/dictionary.json.js | 2 +- test/diffs/newline-at-eof.json.js | 2 +- test/diffs/no-newline-at-eof.json.js | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/diffs/dictionary.json.js b/test/diffs/dictionary.json.js index 746932d9e..a3c2992c8 100644 --- a/test/diffs/dictionary.json.js +++ b/test/diffs/dictionary.json.js @@ -1 +1 @@ -[{"left":[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}]}] \ No newline at end of file +{"rows":[{"left":[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}]}]} \ No newline at end of file diff --git a/test/diffs/newline-at-eof.json.js b/test/diffs/newline-at-eof.json.js index 81c1b5c01..e94d930f8 100644 --- a/test/diffs/newline-at-eof.json.js +++ b/test/diffs/newline-at-eof.json.js @@ -1 +1 @@ -[{"left":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[30,56],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[29,29],"syntax":{"children":[],"type":"indexed"}}],"right":[{"categories":["program"],"range":[56,56],"syntax":{"children":[],"type":"indexed"}}]}] \ No newline at end of file +{"rows":[{"left":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[30,56],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[29,29],"syntax":{"children":[],"type":"indexed"}}],"right":[{"categories":["program"],"range":[56,56],"syntax":{"children":[],"type":"indexed"}}]}]} \ No newline at end of file diff --git a/test/diffs/no-newline-at-eof.json.js b/test/diffs/no-newline-at-eof.json.js index cbd40a8fc..62b7000ec 100644 --- a/test/diffs/no-newline-at-eof.json.js +++ b/test/diffs/no-newline-at-eof.json.js @@ -1 +1 @@ -[{"left":[{"categories":["program"],"range":[0,28],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[30,55],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]}] \ No newline at end of file +{"rows":[{"left":[{"categories":["program"],"range":[0,28],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[30,55],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]}]} \ No newline at end of file From 92732af3d14467771db8e41321ba59560db75b6b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 22:02:44 -0500 Subject: [PATCH 095/149] Tidier Range encoding. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 2b5f4240b..be5484f2d 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -31,7 +31,7 @@ instance ToJSON Category where toJSON (Other s) = String $ T.pack s toJSON s = String . T.pack $ show s instance ToJSON Range where - toJSON (Range start end) = Array (fromList [ toJSON start, toJSON end ]) + toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ] instance ToJSON a => ToJSON (Row a) where toJSON (Row left right) = object [ "left" .= toJSON (fromList $ unLine left), "right" .= toJSON (fromList $ unLine right) ] instance ToJSON leaf => ToJSON (SplitDiff leaf Info) where From 25643aac9b0afd3eda0c761df58b9cf61baa5d74 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 22:02:54 -0500 Subject: [PATCH 096/149] Encode Rows as two-element arrays. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index be5484f2d..7a79f968c 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -33,7 +33,7 @@ instance ToJSON Category where instance ToJSON Range where toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ] instance ToJSON a => ToJSON (Row a) where - toJSON (Row left right) = object [ "left" .= toJSON (fromList $ unLine left), "right" .= toJSON (fromList $ unLine right) ] + toJSON (Row left right) = Array . fromList $ toJSON . fromList . unLine <$> [ left, right ] instance ToJSON leaf => ToJSON (SplitDiff leaf Info) where toJSON (Free (Annotated (Info range categories) syntax)) = object [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] toJSON (Pure patch) = toJSON patch From 435dde08883cf4e6b4632b882df91d1fa226d92a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 29 Feb 2016 22:05:25 -0500 Subject: [PATCH 097/149] Bump the fixtures again. --- test/diffs/dictionary.json.js | 2 +- test/diffs/newline-at-eof.json.js | 2 +- test/diffs/no-newline-at-eof.json.js | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/diffs/dictionary.json.js b/test/diffs/dictionary.json.js index a3c2992c8..f84649c1d 100644 --- a/test/diffs/dictionary.json.js +++ b/test/diffs/dictionary.json.js @@ -1 +1 @@ -{"rows":[{"left":[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}]}]} \ No newline at end of file +{"rows":[[[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}]]]} \ No newline at end of file diff --git a/test/diffs/newline-at-eof.json.js b/test/diffs/newline-at-eof.json.js index e94d930f8..c50a07b79 100644 --- a/test/diffs/newline-at-eof.json.js +++ b/test/diffs/newline-at-eof.json.js @@ -1 +1 @@ -{"rows":[{"left":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[30,56],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]},{"left":[{"categories":["program"],"range":[29,29],"syntax":{"children":[],"type":"indexed"}}],"right":[{"categories":["program"],"range":[56,56],"syntax":{"children":[],"type":"indexed"}}]}]} \ No newline at end of file +{"rows":[[[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[],[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]],[[],[{"categories":["program"],"range":[30,56],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]],[[{"categories":["program"],"range":[29,29],"syntax":{"children":[],"type":"indexed"}}],[{"categories":["program"],"range":[56,56],"syntax":{"children":[],"type":"indexed"}}]]]} \ No newline at end of file diff --git a/test/diffs/no-newline-at-eof.json.js b/test/diffs/no-newline-at-eof.json.js index 62b7000ec..ccaf827bb 100644 --- a/test/diffs/no-newline-at-eof.json.js +++ b/test/diffs/no-newline-at-eof.json.js @@ -1 +1 @@ -{"rows":[{"left":[{"categories":["program"],"range":[0,28],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"right":[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]},{"left":[],"right":[{"categories":["program"],"range":[30,55],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]}]} \ No newline at end of file +{"rows":[[[{"categories":["program"],"range":[0,28],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[],[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]],[[],[{"categories":["program"],"range":[30,55],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]]]} \ No newline at end of file From c2054358a96775148d0c4f624118be90383330b1 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:27:42 -0500 Subject: [PATCH 098/149] Encode the JSON output directly. --- src/Renderer/JSON.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index d8b2bc058..f4215120b 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -9,6 +9,7 @@ import Category import Control.Comonad.Cofree import Control.Monad.Free import Data.Aeson hiding (json) +import Data.ByteString.Builder import Data.ByteString.Lazy import Data.Functor.Both import Data.OrderedMap hiding (fromList) @@ -26,7 +27,7 @@ import Term -- | Render a diff to a string representing its JSON. json :: Renderer a ByteString -json diff sources = encode $ object [ "rows" .= Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources)) ] +json diff sources = toLazyByteString . fromEncoding $ pairs ("rows" .= Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources))) instance ToJSON Category where toJSON (Other s) = String $ T.pack s From 47612988a11cc2f53d885c09a86345c77f866df4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:29:13 -0500 Subject: [PATCH 099/149] Encode terms directly. --- src/Renderer/JSON.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index f4215120b..d717257f8 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -12,6 +12,7 @@ import Data.Aeson hiding (json) import Data.ByteString.Builder import Data.ByteString.Lazy import Data.Functor.Both +import Data.Monoid import Data.OrderedMap hiding (fromList) import qualified Data.Text as T import Data.Vector hiding (toList) @@ -50,3 +51,4 @@ instance (ToJSON recur) => ToJSON (Syntax leaf recur) where toJSON (Keyed c) = object [ "type" .= String "fixed", "children" .= object (uncurry (.=) <$> toList c) ] instance ToJSON (Term leaf Info) where toJSON (Info range categories :< syntax) = object [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] + toEncoding (Info range categories :< syntax) = pairs ("range" .= toJSON range <> "categories" .= toJSON categories <> "syntax" .= toJSON syntax) From 9b52fcc5c58a565ed242d8aecbfec214ec033a02 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:33:23 -0500 Subject: [PATCH 100/149] Extract a function for constructing a Series for the elements of a Term. --- src/Renderer/JSON.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index d717257f8..087701f5a 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -51,4 +51,7 @@ instance (ToJSON recur) => ToJSON (Syntax leaf recur) where toJSON (Keyed c) = object [ "type" .= String "fixed", "children" .= object (uncurry (.=) <$> toList c) ] instance ToJSON (Term leaf Info) where toJSON (Info range categories :< syntax) = object [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] - toEncoding (Info range categories :< syntax) = pairs ("range" .= toJSON range <> "categories" .= toJSON categories <> "syntax" .= toJSON syntax) + toEncoding (info :< syntax) = pairs (termSeries info syntax) + +termSeries :: ToJSON recur => Info -> Syntax leaf recur -> Series +termSeries (Info range categories) syntax = "range" .= toJSON range <> "categories" .= toJSON categories <> "syntax" .= toJSON syntax From 7ebf893bd8ccb8e9ae97ade6079a63328657bf5f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:34:48 -0500 Subject: [PATCH 101/149] Implement toEncoding over diffs via termSeries. --- src/Renderer/JSON.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 087701f5a..f3a960a50 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -40,6 +40,8 @@ instance ToJSON a => ToJSON (Row a) where instance ToJSON (SplitDiff leaf Info) where toJSON (Free (Annotated (Info range categories) syntax)) = object [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] toJSON (Pure patch) = toJSON patch + toEncoding (Free (Annotated info syntax)) = pairs (termSeries info syntax) + toEncoding (Pure patch) = toEncoding patch instance ToJSON a => ToJSON (SplitPatch a) where toJSON (SplitInsert a) = object [ "insert" .= toJSON a ] toJSON (SplitDelete a) = object [ "delete" .= toJSON a ] From 2b3116fcbbb6338bb931ba71ed24db57989a760a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:40:24 -0500 Subject: [PATCH 102/149] Encode patches directly into the node. --- src/Renderer/JSON.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index f3a960a50..d033c03db 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -41,7 +41,11 @@ instance ToJSON (SplitDiff leaf Info) where toJSON (Free (Annotated (Info range categories) syntax)) = object [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] toJSON (Pure patch) = toJSON patch toEncoding (Free (Annotated info syntax)) = pairs (termSeries info syntax) - toEncoding (Pure patch) = toEncoding patch + toEncoding (Pure patch) = pairs . series $ case patch of + SplitInsert a -> ("insert", a) + SplitDelete a -> ("delete", a) + SplitReplace a -> ("replace", a) + where series (kind, (info :< syntax)) = termSeries info syntax <> "patch" .= T.pack kind instance ToJSON a => ToJSON (SplitPatch a) where toJSON (SplitInsert a) = object [ "insert" .= toJSON a ] toJSON (SplitDelete a) = object [ "delete" .= toJSON a ] From 0ac2fe19a5f25308f10c3f124910d0db179241ec Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:43:28 -0500 Subject: [PATCH 103/149] Extract a function to compute a list of pairs representing a term. --- src/Renderer/JSON.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index d033c03db..0bb9e4122 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -8,7 +8,7 @@ import Alignment import Category import Control.Comonad.Cofree import Control.Monad.Free -import Data.Aeson hiding (json) +import Data.Aeson.Types import Data.ByteString.Builder import Data.ByteString.Lazy import Data.Functor.Both @@ -61,3 +61,6 @@ instance ToJSON (Term leaf Info) where termSeries :: ToJSON recur => Info -> Syntax leaf recur -> Series termSeries (Info range categories) syntax = "range" .= toJSON range <> "categories" .= toJSON categories <> "syntax" .= toJSON syntax + +termPairs :: ToJSON recur => Info -> Syntax leaf recur -> [Pair] +termPairs (Info range categories) syntax = [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] From 522f14cf668140f7b92159562b403fbc3beb06e8 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:46:04 -0500 Subject: [PATCH 104/149] Add a termFields function abstracted over a KeyValue type. --- src/Renderer/JSON.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 0bb9e4122..f5d592ad3 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -64,3 +64,6 @@ termSeries (Info range categories) syntax = "range" .= toJSON range <> "categori termPairs :: ToJSON recur => Info -> Syntax leaf recur -> [Pair] termPairs (Info range categories) syntax = [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] + +termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] +termFields (Info range categories) syntax = [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] From 233a0136ab92a4144413d7b54fcf1cc0bd48bd43 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:46:34 -0500 Subject: [PATCH 105/149] :fire: termPairs. --- src/Renderer/JSON.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index f5d592ad3..26deb3328 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -62,8 +62,5 @@ instance ToJSON (Term leaf Info) where termSeries :: ToJSON recur => Info -> Syntax leaf recur -> Series termSeries (Info range categories) syntax = "range" .= toJSON range <> "categories" .= toJSON categories <> "syntax" .= toJSON syntax -termPairs :: ToJSON recur => Info -> Syntax leaf recur -> [Pair] -termPairs (Info range categories) syntax = [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] - termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] termFields (Info range categories) syntax = [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] From 3b2f5cf44aa2847b4187add317292cfc10924719 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:47:03 -0500 Subject: [PATCH 106/149] Go back to the basic import. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 26deb3328..be129acc8 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -8,7 +8,7 @@ import Alignment import Category import Control.Comonad.Cofree import Control.Monad.Free -import Data.Aeson.Types +import Data.Aeson hiding (json) import Data.ByteString.Builder import Data.ByteString.Lazy import Data.Functor.Both From 60e0ca33371ddd798fa25a9522e81bb763125508 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:48:01 -0500 Subject: [PATCH 107/149] Define termSeries in terms of termFields. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index be129acc8..126c26d32 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -60,7 +60,7 @@ instance ToJSON (Term leaf Info) where toEncoding (info :< syntax) = pairs (termSeries info syntax) termSeries :: ToJSON recur => Info -> Syntax leaf recur -> Series -termSeries (Info range categories) syntax = "range" .= toJSON range <> "categories" .= toJSON categories <> "syntax" .= toJSON syntax +termSeries info = mconcat . termFields info termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] termFields (Info range categories) syntax = [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] From 526c9ba26fbd31fef0cfc177fe77bccecb65b093 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:48:57 -0500 Subject: [PATCH 108/149] Construct Values from Terms using termFields. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 126c26d32..bb93d263e 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -56,7 +56,7 @@ instance (ToJSON recur) => ToJSON (Syntax leaf recur) where toJSON (Fixed c) = object [ "type" .= String "fixed", "children" .= Array (fromList $ toJSON <$> c) ] toJSON (Keyed c) = object [ "type" .= String "fixed", "children" .= object (uncurry (.=) <$> toList c) ] instance ToJSON (Term leaf Info) where - toJSON (Info range categories :< syntax) = object [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] + toJSON (info :< syntax) = object (termFields info syntax) toEncoding (info :< syntax) = pairs (termSeries info syntax) termSeries :: ToJSON recur => Info -> Syntax leaf recur -> Series From 1cf91d94dd83b0e225090712336201f9cae0606e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:49:28 -0500 Subject: [PATCH 109/149] Construct Values from Diffs using termFields. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index bb93d263e..603486ad5 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -38,7 +38,7 @@ instance ToJSON Range where instance ToJSON a => ToJSON (Row a) where toJSON (Row (Both (left, right))) = Array . fromList $ toJSON . fromList . unLine <$> [ left, right ] instance ToJSON (SplitDiff leaf Info) where - toJSON (Free (Annotated (Info range categories) syntax)) = object [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] + toJSON (Free (Annotated info syntax)) = object (termFields info syntax) toJSON (Pure patch) = toJSON patch toEncoding (Free (Annotated info syntax)) = pairs (termSeries info syntax) toEncoding (Pure patch) = pairs . series $ case patch of From de7da757e1ae7a3ab4ce9e7a9a28f1a7a5923148 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:51:40 -0500 Subject: [PATCH 110/149] Rename the helper function to `fields`. --- src/Renderer/JSON.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 603486ad5..1a4638b65 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -41,11 +41,11 @@ instance ToJSON (SplitDiff leaf Info) where toJSON (Free (Annotated info syntax)) = object (termFields info syntax) toJSON (Pure patch) = toJSON patch toEncoding (Free (Annotated info syntax)) = pairs (termSeries info syntax) - toEncoding (Pure patch) = pairs . series $ case patch of + toEncoding (Pure patch) = pairs . fields $ case patch of SplitInsert a -> ("insert", a) SplitDelete a -> ("delete", a) SplitReplace a -> ("replace", a) - where series (kind, (info :< syntax)) = termSeries info syntax <> "patch" .= T.pack kind + where fields (kind, (info :< syntax)) = termSeries info syntax <> "patch" .= T.pack kind instance ToJSON a => ToJSON (SplitPatch a) where toJSON (SplitInsert a) = object [ "insert" .= toJSON a ] toJSON (SplitDelete a) = object [ "delete" .= toJSON a ] From 41e9c875d44a5e1d071386b6491892002dd8a234 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 13:58:18 -0500 Subject: [PATCH 111/149] Extract a patchFields function. --- src/Renderer/JSON.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 1a4638b65..ac95174a4 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -64,3 +64,10 @@ termSeries info = mconcat . termFields info termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] termFields (Info range categories) syntax = [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] + +patchFields :: KeyValue kv => SplitPatch (Cofree (Syntax leaf) Info) -> [kv] +patchFields patch = case patch of + SplitInsert term -> fields "insert" term + SplitDelete term -> fields "delete" term + SplitReplace term -> fields "replace" term + where fields kind (info :< syntax) = "patch" .= T.pack kind : termFields info syntax From a27cfdd5a8ede322d088fe06bcc77344889066f9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:00:08 -0500 Subject: [PATCH 112/149] Use patchFields to construct/encode JSON for patches. --- src/Renderer/JSON.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index ac95174a4..e8634d5f6 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -12,7 +12,6 @@ import Data.Aeson hiding (json) import Data.ByteString.Builder import Data.ByteString.Lazy import Data.Functor.Both -import Data.Monoid import Data.OrderedMap hiding (fromList) import qualified Data.Text as T import Data.Vector hiding (toList) @@ -39,13 +38,9 @@ instance ToJSON a => ToJSON (Row a) where toJSON (Row (Both (left, right))) = Array . fromList $ toJSON . fromList . unLine <$> [ left, right ] instance ToJSON (SplitDiff leaf Info) where toJSON (Free (Annotated info syntax)) = object (termFields info syntax) - toJSON (Pure patch) = toJSON patch + toJSON (Pure patch) = object (patchFields patch) toEncoding (Free (Annotated info syntax)) = pairs (termSeries info syntax) - toEncoding (Pure patch) = pairs . fields $ case patch of - SplitInsert a -> ("insert", a) - SplitDelete a -> ("delete", a) - SplitReplace a -> ("replace", a) - where fields (kind, (info :< syntax)) = termSeries info syntax <> "patch" .= T.pack kind + toEncoding (Pure patch) = pairs $ mconcat (patchFields patch) instance ToJSON a => ToJSON (SplitPatch a) where toJSON (SplitInsert a) = object [ "insert" .= toJSON a ] toJSON (SplitDelete a) = object [ "delete" .= toJSON a ] From 700c4ce17a7d9ef94fa055de648902bf916a8bf9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:01:12 -0500 Subject: [PATCH 113/149] =?UTF-8?q?Use=20mconcat=C2=A0directly=20instead?= =?UTF-8?q?=20of=20termSeries.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Renderer/JSON.hs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index e8634d5f6..e4d3c977f 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -39,7 +39,7 @@ instance ToJSON a => ToJSON (Row a) where instance ToJSON (SplitDiff leaf Info) where toJSON (Free (Annotated info syntax)) = object (termFields info syntax) toJSON (Pure patch) = object (patchFields patch) - toEncoding (Free (Annotated info syntax)) = pairs (termSeries info syntax) + toEncoding (Free (Annotated info syntax)) = pairs $ mconcat (termFields info syntax) toEncoding (Pure patch) = pairs $ mconcat (patchFields patch) instance ToJSON a => ToJSON (SplitPatch a) where toJSON (SplitInsert a) = object [ "insert" .= toJSON a ] @@ -52,10 +52,7 @@ instance (ToJSON recur) => ToJSON (Syntax leaf recur) where toJSON (Keyed c) = object [ "type" .= String "fixed", "children" .= object (uncurry (.=) <$> toList c) ] instance ToJSON (Term leaf Info) where toJSON (info :< syntax) = object (termFields info syntax) - toEncoding (info :< syntax) = pairs (termSeries info syntax) - -termSeries :: ToJSON recur => Info -> Syntax leaf recur -> Series -termSeries info = mconcat . termFields info + toEncoding (info :< syntax) = pairs $ mconcat (termFields info syntax) termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] termFields (Info range categories) syntax = [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] From 1a3091660e804764c314705388391b16aeefd839 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:01:38 -0500 Subject: [PATCH 114/149] Remove the ToJSON instance for SplitPatch. --- src/Renderer/JSON.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index e4d3c977f..efba1fe2a 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -41,10 +41,6 @@ instance ToJSON (SplitDiff leaf Info) where toJSON (Pure patch) = object (patchFields patch) toEncoding (Free (Annotated info syntax)) = pairs $ mconcat (termFields info syntax) toEncoding (Pure patch) = pairs $ mconcat (patchFields patch) -instance ToJSON a => ToJSON (SplitPatch a) where - toJSON (SplitInsert a) = object [ "insert" .= toJSON a ] - toJSON (SplitDelete a) = object [ "delete" .= toJSON a ] - toJSON (SplitReplace a) = object [ "replace" .= toJSON a ] instance (ToJSON recur) => ToJSON (Syntax leaf recur) where toJSON (Leaf _) = object [ "type" .= String "leaf" ] toJSON (Indexed c) = object [ "type" .= String "indexed", "children" .= Array (fromList $ toJSON <$> c) ] From 1f5d81259803a6a8e8a5575a44b257fd7a5444dd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:08:34 -0500 Subject: [PATCH 115/149] Remove some parens. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index efba1fe2a..86be06541 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -41,7 +41,7 @@ instance ToJSON (SplitDiff leaf Info) where toJSON (Pure patch) = object (patchFields patch) toEncoding (Free (Annotated info syntax)) = pairs $ mconcat (termFields info syntax) toEncoding (Pure patch) = pairs $ mconcat (patchFields patch) -instance (ToJSON recur) => ToJSON (Syntax leaf recur) where +instance ToJSON recur => ToJSON (Syntax leaf recur) where toJSON (Leaf _) = object [ "type" .= String "leaf" ] toJSON (Indexed c) = object [ "type" .= String "indexed", "children" .= Array (fromList $ toJSON <$> c) ] toJSON (Fixed c) = object [ "type" .= String "fixed", "children" .= Array (fromList $ toJSON <$> c) ] From 91f7c56b4038038f1150c8151580a1ee2057a6b5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:10:28 -0500 Subject: [PATCH 116/149] Add a ToJSON instance for OrderedMap. --- src/Renderer/JSON.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 86be06541..baadb4a65 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -46,6 +46,9 @@ instance ToJSON recur => ToJSON (Syntax leaf recur) where toJSON (Indexed c) = object [ "type" .= String "indexed", "children" .= Array (fromList $ toJSON <$> c) ] toJSON (Fixed c) = object [ "type" .= String "fixed", "children" .= Array (fromList $ toJSON <$> c) ] toJSON (Keyed c) = object [ "type" .= String "fixed", "children" .= object (uncurry (.=) <$> toList c) ] +instance ToJSON value => ToJSON (OrderedMap T.Text value) where + toJSON map = object $ uncurry (.=) <$> toList map + toEncoding map = pairs . mconcat $ uncurry (.=) <$> toList map instance ToJSON (Term leaf Info) where toJSON (info :< syntax) = object (termFields info syntax) toEncoding (info :< syntax) = pairs $ mconcat (termFields info syntax) From 9815cb9aab4557de8b29762038047ca56a716d3a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:10:55 -0500 Subject: [PATCH 117/149] Defer to the OrderedMap instance. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index baadb4a65..de2ad60bc 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -45,7 +45,7 @@ instance ToJSON recur => ToJSON (Syntax leaf recur) where toJSON (Leaf _) = object [ "type" .= String "leaf" ] toJSON (Indexed c) = object [ "type" .= String "indexed", "children" .= Array (fromList $ toJSON <$> c) ] toJSON (Fixed c) = object [ "type" .= String "fixed", "children" .= Array (fromList $ toJSON <$> c) ] - toJSON (Keyed c) = object [ "type" .= String "fixed", "children" .= object (uncurry (.=) <$> toList c) ] + toJSON (Keyed c) = object [ "type" .= String "fixed", "children" .= c ] instance ToJSON value => ToJSON (OrderedMap T.Text value) where toJSON map = object $ uncurry (.=) <$> toList map toEncoding map = pairs . mconcat $ uncurry (.=) <$> toList map From 42e488bb6cc0863337d0e80b2c28d2e7012b1354 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:11:56 -0500 Subject: [PATCH 118/149] Encode Syntax fields directly into the term fields. --- src/Renderer/JSON.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index de2ad60bc..6e05aa038 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -54,7 +54,12 @@ instance ToJSON (Term leaf Info) where toEncoding (info :< syntax) = pairs $ mconcat (termFields info syntax) termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] -termFields (Info range categories) syntax = [ "range" .= toJSON range, "categories" .= toJSON categories, "syntax" .= toJSON syntax ] +termFields (Info range categories) syntax = "range" .= toJSON range : "categories" .= toJSON categories : case syntax of + Leaf _ -> [] + Indexed c -> childrenFields c + Fixed c -> childrenFields c + Keyed c -> childrenFields c + where childrenFields c = [ "children" .= c ] patchFields :: KeyValue kv => SplitPatch (Cofree (Syntax leaf) Info) -> [kv] patchFields patch = case patch of From c20308e8cd24eaa97348be7a8ed3bbdd7767dfb7 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:12:01 -0500 Subject: [PATCH 119/149] Remove the ToJSON instance for Syntax. --- src/Renderer/JSON.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 6e05aa038..a95ea12eb 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -41,11 +41,6 @@ instance ToJSON (SplitDiff leaf Info) where toJSON (Pure patch) = object (patchFields patch) toEncoding (Free (Annotated info syntax)) = pairs $ mconcat (termFields info syntax) toEncoding (Pure patch) = pairs $ mconcat (patchFields patch) -instance ToJSON recur => ToJSON (Syntax leaf recur) where - toJSON (Leaf _) = object [ "type" .= String "leaf" ] - toJSON (Indexed c) = object [ "type" .= String "indexed", "children" .= Array (fromList $ toJSON <$> c) ] - toJSON (Fixed c) = object [ "type" .= String "fixed", "children" .= Array (fromList $ toJSON <$> c) ] - toJSON (Keyed c) = object [ "type" .= String "fixed", "children" .= c ] instance ToJSON value => ToJSON (OrderedMap T.Text value) where toJSON map = object $ uncurry (.=) <$> toList map toEncoding map = pairs . mconcat $ uncurry (.=) <$> toList map From 201fb1383f09f7c9a64484560b7f8c259dc422d3 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:13:12 -0500 Subject: [PATCH 120/149] Remove explicit calls to toJSON. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index a95ea12eb..96114cf3c 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -49,7 +49,7 @@ instance ToJSON (Term leaf Info) where toEncoding (info :< syntax) = pairs $ mconcat (termFields info syntax) termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] -termFields (Info range categories) syntax = "range" .= toJSON range : "categories" .= toJSON categories : case syntax of +termFields (Info range categories) syntax = "range" .= range : "categories" .= categories : case syntax of Leaf _ -> [] Indexed c -> childrenFields c Fixed c -> childrenFields c From 03aff88442bd6e26451d6ccb69589d180076d336 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:17:49 -0500 Subject: [PATCH 121/149] Add a ToJSON instance for Both. --- src/Renderer/JSON.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 96114cf3c..9883ebf92 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -36,6 +36,9 @@ instance ToJSON Range where toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ] instance ToJSON a => ToJSON (Row a) where toJSON (Row (Both (left, right))) = Array . fromList $ toJSON . fromList . unLine <$> [ left, right ] +instance ToJSON a => ToJSON (Both a) where + toJSON (Both (a, b)) = Array . fromList $ toJSON <$> [ a, b ] + toEncoding both = foldable both instance ToJSON (SplitDiff leaf Info) where toJSON (Free (Annotated info syntax)) = object (termFields info syntax) toJSON (Pure patch) = object (patchFields patch) From a3d541af1e7ff1efadfd7be53ed34c7b01aaf4a6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:23:52 -0500 Subject: [PATCH 122/149] Add a ToJSON instance for Line. --- src/Renderer/JSON.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 9883ebf92..a0c67c93e 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -36,6 +36,9 @@ instance ToJSON Range where toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ] instance ToJSON a => ToJSON (Row a) where toJSON (Row (Both (left, right))) = Array . fromList $ toJSON . fromList . unLine <$> [ left, right ] +instance ToJSON a => ToJSON (Line a) where + toJSON = Array . fromList . fmap toJSON . unLine + toEncoding = foldable . unLine instance ToJSON a => ToJSON (Both a) where toJSON (Both (a, b)) = Array . fromList $ toJSON <$> [ a, b ] toEncoding both = foldable both From 53a7774aef8f181c9b31559b92be3a076adfbdc1 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:24:22 -0500 Subject: [PATCH 123/149] The ToJSON instance for Row operates over Both Lines. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index a0c67c93e..8a3906325 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -35,7 +35,7 @@ instance ToJSON Category where instance ToJSON Range where toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ] instance ToJSON a => ToJSON (Row a) where - toJSON (Row (Both (left, right))) = Array . fromList $ toJSON . fromList . unLine <$> [ left, right ] + toJSON (Row both) = toJSON both instance ToJSON a => ToJSON (Line a) where toJSON = Array . fromList . fmap toJSON . unLine toEncoding = foldable . unLine From 5e4df2c047db0a217250bd2d7cb0b92d535617f2 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:24:29 -0500 Subject: [PATCH 124/149] The ToJSON instance for Row encodes. --- src/Renderer/JSON.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 8a3906325..59ec19613 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -36,6 +36,7 @@ instance ToJSON Range where toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ] instance ToJSON a => ToJSON (Row a) where toJSON (Row both) = toJSON both + toEncoding (Row both) = toEncoding both instance ToJSON a => ToJSON (Line a) where toJSON = Array . fromList . fmap toJSON . unLine toEncoding = foldable . unLine From cb90318b477a8cdfde436be77a4e775be971a3a0 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:25:12 -0500 Subject: [PATCH 125/149] The ToJSON instance for Range encodes. --- src/Renderer/JSON.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 59ec19613..97627099e 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -34,6 +34,7 @@ instance ToJSON Category where toJSON s = String . T.pack $ show s instance ToJSON Range where toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ] + toEncoding (Range start end) = foldable [ start, end ] instance ToJSON a => ToJSON (Row a) where toJSON (Row both) = toJSON both toEncoding (Row both) = toEncoding both From ab77d09bb6a474728c65b7d78f56104f19e856e5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:30:23 -0500 Subject: [PATCH 126/149] Bump all the fixtures. --- test/diffs/dictionary.json.js | 2 +- test/diffs/newline-at-eof.json.js | 2 +- test/diffs/no-newline-at-eof.json.js | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/diffs/dictionary.json.js b/test/diffs/dictionary.json.js index f84649c1d..f8dbb3b98 100644 --- a/test/diffs/dictionary.json.js +++ b/test/diffs/dictionary.json.js @@ -1 +1 @@ -{"rows":[[[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[0,2],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,2],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[0,2],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[2,12],"syntax":{"children":[{"categories":["expression_statement"],"range":[2,12],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[2,12],"syntax":{"children":{"\"b\"":{"categories":["Pair"],"range":[4,10],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,7],"syntax":{"children":[{"categories":["StringLiteral"],"range":[4,5],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[5,6],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[6,7],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"replace":{"categories":["number"],"range":[9,10],"syntax":{"type":"leaf"}}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[12,21],"syntax":{"children":[{"categories":["expression_statement"],"range":[12,21],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[12,21],"syntax":{"children":{"\"a\"":{"categories":["Pair"],"range":[14,20],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,17],"syntax":{"children":[{"categories":["StringLiteral"],"range":[14,15],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[15,16],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[16,17],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["number"],"range":[19,20],"syntax":{"type":"leaf"}}],"type":"fixed"}}},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[21,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[21,23],"syntax":{"children":[{"categories":["DictionaryLiteral"],"range":[21,22],"syntax":{"children":{},"type":"fixed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[23,23],"syntax":{"children":[{"categories":["expression_statement"],"range":[23,23],"syntax":{"children":[],"type":"indexed"}}],"type":"indexed"}}]]]} \ No newline at end of file +{"rows":[[[{"range":[0,2],"categories":["program"],"children":[{"range":[0,2],"categories":["expression_statement"],"children":[{"range":[0,2],"categories":["DictionaryLiteral"],"children":{}}]}]}],[{"range":[0,2],"categories":["program"],"children":[{"range":[0,2],"categories":["expression_statement"],"children":[{"range":[0,2],"categories":["DictionaryLiteral"],"children":{}}]}]}]],[[{"range":[2,12],"categories":["program"],"children":[{"range":[2,12],"categories":["expression_statement"],"children":[{"range":[2,12],"categories":["DictionaryLiteral"],"children":{"\"b\"":{"range":[4,10],"categories":["Pair"],"children":[{"range":[4,7],"categories":["StringLiteral"],"children":[{"range":[4,5],"categories":["StringLiteral"]},{"range":[5,6],"categories":["StringLiteral"]},{"range":[6,7],"categories":["StringLiteral"]}]},{"patch":"replace","range":[9,10],"categories":["number"]}]}}}]}]}],[{"range":[2,12],"categories":["program"],"children":[{"range":[2,12],"categories":["expression_statement"],"children":[{"range":[2,12],"categories":["DictionaryLiteral"],"children":{"\"b\"":{"range":[4,10],"categories":["Pair"],"children":[{"range":[4,7],"categories":["StringLiteral"],"children":[{"range":[4,5],"categories":["StringLiteral"]},{"range":[5,6],"categories":["StringLiteral"]},{"range":[6,7],"categories":["StringLiteral"]}]},{"patch":"replace","range":[9,10],"categories":["number"]}]}}}]}]}]],[[{"range":[12,21],"categories":["program"],"children":[{"range":[12,21],"categories":["expression_statement"],"children":[{"range":[12,21],"categories":["DictionaryLiteral"],"children":{"\"a\"":{"range":[14,20],"categories":["Pair"],"children":[{"range":[14,17],"categories":["StringLiteral"],"children":[{"range":[14,15],"categories":["StringLiteral"]},{"range":[15,16],"categories":["StringLiteral"]},{"range":[16,17],"categories":["StringLiteral"]}]},{"range":[19,20],"categories":["number"]}]}}}]}]}],[{"range":[12,21],"categories":["program"],"children":[{"range":[12,21],"categories":["expression_statement"],"children":[{"range":[12,21],"categories":["DictionaryLiteral"],"children":{"\"a\"":{"range":[14,20],"categories":["Pair"],"children":[{"range":[14,17],"categories":["StringLiteral"],"children":[{"range":[14,15],"categories":["StringLiteral"]},{"range":[15,16],"categories":["StringLiteral"]},{"range":[16,17],"categories":["StringLiteral"]}]},{"range":[19,20],"categories":["number"]}]}}}]}]}]],[[{"range":[21,23],"categories":["program"],"children":[{"range":[21,23],"categories":["expression_statement"],"children":[{"range":[21,22],"categories":["DictionaryLiteral"],"children":{}}]}]}],[{"range":[21,23],"categories":["program"],"children":[{"range":[21,23],"categories":["expression_statement"],"children":[{"range":[21,22],"categories":["DictionaryLiteral"],"children":{}}]}]}]],[[{"range":[23,23],"categories":["program"],"children":[{"range":[23,23],"categories":["expression_statement"],"children":[]}]}],[{"range":[23,23],"categories":["program"],"children":[{"range":[23,23],"categories":["expression_statement"],"children":[]}]}]]]} \ No newline at end of file diff --git a/test/diffs/newline-at-eof.json.js b/test/diffs/newline-at-eof.json.js index c50a07b79..1916154d8 100644 --- a/test/diffs/newline-at-eof.json.js +++ b/test/diffs/newline-at-eof.json.js @@ -1 +1 @@ -{"rows":[[[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[],[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]],[[],[{"categories":["program"],"range":[30,56],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]],[[{"categories":["program"],"range":[29,29],"syntax":{"children":[],"type":"indexed"}}],[{"categories":["program"],"range":[56,56],"syntax":{"children":[],"type":"indexed"}}]]]} \ No newline at end of file +{"rows":[[[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}]],[[],[{"range":[29,30],"categories":["program"],"children":[]}]],[[],[{"range":[30,56],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}]],[[{"range":[29,29],"categories":["program"],"children":[]}],[{"range":[56,56],"categories":["program"],"children":[]}]]]} \ No newline at end of file diff --git a/test/diffs/no-newline-at-eof.json.js b/test/diffs/no-newline-at-eof.json.js index ccaf827bb..87d59f114 100644 --- a/test/diffs/no-newline-at-eof.json.js +++ b/test/diffs/no-newline-at-eof.json.js @@ -1 +1 @@ -{"rows":[[[{"categories":["program"],"range":[0,28],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],[{"categories":["program"],"range":[0,29],"syntax":{"children":[{"categories":["expression_statement"],"range":[0,28],"syntax":{"children":[{"categories":["FunctionCall"],"range":[0,27],"syntax":{"children":[{"categories":["member_access"],"range":[0,11],"syntax":{"children":[{"categories":["identifier"],"range":[0,7],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[8,11],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,26],"syntax":{"children":[{"categories":["StringLiteral"],"range":[12,13],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[13,18],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[18,19],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[20,25],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[25,26],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}]],[[],[{"categories":["program"],"range":[29,30],"syntax":{"children":[],"type":"indexed"}}]],[[],[{"categories":["program"],"range":[30,55],"syntax":{"children":[{"insert":{"categories":["expression_statement"],"range":[30,55],"syntax":{"children":[{"categories":["FunctionCall"],"range":[30,54],"syntax":{"children":[{"categories":["member_access"],"range":[30,41],"syntax":{"children":[{"categories":["identifier"],"range":[30,37],"syntax":{"type":"leaf"}},{"categories":["identifier"],"range":[38,41],"syntax":{"type":"leaf"}}],"type":"indexed"}},{"categories":["arguments"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,53],"syntax":{"children":[{"categories":["StringLiteral"],"range":[42,43],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[43,52],"syntax":{"type":"leaf"}},{"categories":["StringLiteral"],"range":[52,53],"syntax":{"type":"leaf"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}],"type":"indexed"}}}],"type":"indexed"}}]]]} \ No newline at end of file +{"rows":[[[{"range":[0,28],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}]],[[],[{"range":[29,30],"categories":["program"],"children":[]}]],[[],[{"range":[30,55],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}]]]} \ No newline at end of file From 03b91f3886571d083d664291b47228a9f50ff6fa Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:35:17 -0500 Subject: [PATCH 127/149] Add source blob oids to the top level. --- src/Renderer/JSON.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 97627099e..9ff6b18cf 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -12,6 +12,7 @@ import Data.Aeson hiding (json) import Data.ByteString.Builder import Data.ByteString.Lazy import Data.Functor.Both +import Data.Monoid import Data.OrderedMap hiding (fromList) import qualified Data.Text as T import Data.Vector hiding (toList) @@ -27,7 +28,7 @@ import Term -- | Render a diff to a string representing its JSON. json :: Renderer a ByteString -json diff sources = toLazyByteString . fromEncoding $ pairs ("rows" .= Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources))) +json diff sources = toLazyByteString . fromEncoding $ pairs ("rows" .= Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources)) <> "oids" .= (oid <$> sources)) instance ToJSON Category where toJSON (Other s) = String $ T.pack s From 3fbc3b3bd1bc7fc2513ff5d70678b3c786745dea Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:36:17 -0500 Subject: [PATCH 128/149] Add blob paths to the top level. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 9ff6b18cf..3c4873e92 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -28,7 +28,7 @@ import Term -- | Render a diff to a string representing its JSON. json :: Renderer a ByteString -json diff sources = toLazyByteString . fromEncoding $ pairs ("rows" .= Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources)) <> "oids" .= (oid <$> sources)) +json diff sources = toLazyByteString . fromEncoding $ pairs ("rows" .= Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources)) <> "oids" .= (oid <$> sources) <> "paths" .= (path <$> sources)) instance ToJSON Category where toJSON (Other s) = String $ T.pack s From a34250e619866a4934e461671c29ff9f815cdeec Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:36:50 -0500 Subject: [PATCH 129/149] Bump the fixtures again. --- test/diffs/dictionary.json.js | 2 +- test/diffs/newline-at-eof.json.js | 2 +- test/diffs/no-newline-at-eof.json.js | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/diffs/dictionary.json.js b/test/diffs/dictionary.json.js index f8dbb3b98..29fefa96f 100644 --- a/test/diffs/dictionary.json.js +++ b/test/diffs/dictionary.json.js @@ -1 +1 @@ -{"rows":[[[{"range":[0,2],"categories":["program"],"children":[{"range":[0,2],"categories":["expression_statement"],"children":[{"range":[0,2],"categories":["DictionaryLiteral"],"children":{}}]}]}],[{"range":[0,2],"categories":["program"],"children":[{"range":[0,2],"categories":["expression_statement"],"children":[{"range":[0,2],"categories":["DictionaryLiteral"],"children":{}}]}]}]],[[{"range":[2,12],"categories":["program"],"children":[{"range":[2,12],"categories":["expression_statement"],"children":[{"range":[2,12],"categories":["DictionaryLiteral"],"children":{"\"b\"":{"range":[4,10],"categories":["Pair"],"children":[{"range":[4,7],"categories":["StringLiteral"],"children":[{"range":[4,5],"categories":["StringLiteral"]},{"range":[5,6],"categories":["StringLiteral"]},{"range":[6,7],"categories":["StringLiteral"]}]},{"patch":"replace","range":[9,10],"categories":["number"]}]}}}]}]}],[{"range":[2,12],"categories":["program"],"children":[{"range":[2,12],"categories":["expression_statement"],"children":[{"range":[2,12],"categories":["DictionaryLiteral"],"children":{"\"b\"":{"range":[4,10],"categories":["Pair"],"children":[{"range":[4,7],"categories":["StringLiteral"],"children":[{"range":[4,5],"categories":["StringLiteral"]},{"range":[5,6],"categories":["StringLiteral"]},{"range":[6,7],"categories":["StringLiteral"]}]},{"patch":"replace","range":[9,10],"categories":["number"]}]}}}]}]}]],[[{"range":[12,21],"categories":["program"],"children":[{"range":[12,21],"categories":["expression_statement"],"children":[{"range":[12,21],"categories":["DictionaryLiteral"],"children":{"\"a\"":{"range":[14,20],"categories":["Pair"],"children":[{"range":[14,17],"categories":["StringLiteral"],"children":[{"range":[14,15],"categories":["StringLiteral"]},{"range":[15,16],"categories":["StringLiteral"]},{"range":[16,17],"categories":["StringLiteral"]}]},{"range":[19,20],"categories":["number"]}]}}}]}]}],[{"range":[12,21],"categories":["program"],"children":[{"range":[12,21],"categories":["expression_statement"],"children":[{"range":[12,21],"categories":["DictionaryLiteral"],"children":{"\"a\"":{"range":[14,20],"categories":["Pair"],"children":[{"range":[14,17],"categories":["StringLiteral"],"children":[{"range":[14,15],"categories":["StringLiteral"]},{"range":[15,16],"categories":["StringLiteral"]},{"range":[16,17],"categories":["StringLiteral"]}]},{"range":[19,20],"categories":["number"]}]}}}]}]}]],[[{"range":[21,23],"categories":["program"],"children":[{"range":[21,23],"categories":["expression_statement"],"children":[{"range":[21,22],"categories":["DictionaryLiteral"],"children":{}}]}]}],[{"range":[21,23],"categories":["program"],"children":[{"range":[21,23],"categories":["expression_statement"],"children":[{"range":[21,22],"categories":["DictionaryLiteral"],"children":{}}]}]}]],[[{"range":[23,23],"categories":["program"],"children":[{"range":[23,23],"categories":["expression_statement"],"children":[]}]}],[{"range":[23,23],"categories":["program"],"children":[{"range":[23,23],"categories":["expression_statement"],"children":[]}]}]]]} \ No newline at end of file +{"rows":[[[{"range":[0,2],"categories":["program"],"children":[{"range":[0,2],"categories":["expression_statement"],"children":[{"range":[0,2],"categories":["DictionaryLiteral"],"children":{}}]}]}],[{"range":[0,2],"categories":["program"],"children":[{"range":[0,2],"categories":["expression_statement"],"children":[{"range":[0,2],"categories":["DictionaryLiteral"],"children":{}}]}]}]],[[{"range":[2,12],"categories":["program"],"children":[{"range":[2,12],"categories":["expression_statement"],"children":[{"range":[2,12],"categories":["DictionaryLiteral"],"children":{"\"b\"":{"range":[4,10],"categories":["Pair"],"children":[{"range":[4,7],"categories":["StringLiteral"],"children":[{"range":[4,5],"categories":["StringLiteral"]},{"range":[5,6],"categories":["StringLiteral"]},{"range":[6,7],"categories":["StringLiteral"]}]},{"patch":"replace","range":[9,10],"categories":["number"]}]}}}]}]}],[{"range":[2,12],"categories":["program"],"children":[{"range":[2,12],"categories":["expression_statement"],"children":[{"range":[2,12],"categories":["DictionaryLiteral"],"children":{"\"b\"":{"range":[4,10],"categories":["Pair"],"children":[{"range":[4,7],"categories":["StringLiteral"],"children":[{"range":[4,5],"categories":["StringLiteral"]},{"range":[5,6],"categories":["StringLiteral"]},{"range":[6,7],"categories":["StringLiteral"]}]},{"patch":"replace","range":[9,10],"categories":["number"]}]}}}]}]}]],[[{"range":[12,21],"categories":["program"],"children":[{"range":[12,21],"categories":["expression_statement"],"children":[{"range":[12,21],"categories":["DictionaryLiteral"],"children":{"\"a\"":{"range":[14,20],"categories":["Pair"],"children":[{"range":[14,17],"categories":["StringLiteral"],"children":[{"range":[14,15],"categories":["StringLiteral"]},{"range":[15,16],"categories":["StringLiteral"]},{"range":[16,17],"categories":["StringLiteral"]}]},{"range":[19,20],"categories":["number"]}]}}}]}]}],[{"range":[12,21],"categories":["program"],"children":[{"range":[12,21],"categories":["expression_statement"],"children":[{"range":[12,21],"categories":["DictionaryLiteral"],"children":{"\"a\"":{"range":[14,20],"categories":["Pair"],"children":[{"range":[14,17],"categories":["StringLiteral"],"children":[{"range":[14,15],"categories":["StringLiteral"]},{"range":[15,16],"categories":["StringLiteral"]},{"range":[16,17],"categories":["StringLiteral"]}]},{"range":[19,20],"categories":["number"]}]}}}]}]}]],[[{"range":[21,23],"categories":["program"],"children":[{"range":[21,23],"categories":["expression_statement"],"children":[{"range":[21,22],"categories":["DictionaryLiteral"],"children":{}}]}]}],[{"range":[21,23],"categories":["program"],"children":[{"range":[21,23],"categories":["expression_statement"],"children":[{"range":[21,22],"categories":["DictionaryLiteral"],"children":{}}]}]}]],[[{"range":[23,23],"categories":["program"],"children":[{"range":[23,23],"categories":["expression_statement"],"children":[]}]}],[{"range":[23,23],"categories":["program"],"children":[{"range":[23,23],"categories":["expression_statement"],"children":[]}]}]]],"oids":["",""],"paths":["test/diffs/dictionary.A.js","test/diffs/dictionary.B.js"]} \ No newline at end of file diff --git a/test/diffs/newline-at-eof.json.js b/test/diffs/newline-at-eof.json.js index 1916154d8..3fc48cf61 100644 --- a/test/diffs/newline-at-eof.json.js +++ b/test/diffs/newline-at-eof.json.js @@ -1 +1 @@ -{"rows":[[[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}]],[[],[{"range":[29,30],"categories":["program"],"children":[]}]],[[],[{"range":[30,56],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}]],[[{"range":[29,29],"categories":["program"],"children":[]}],[{"range":[56,56],"categories":["program"],"children":[]}]]]} \ No newline at end of file +{"rows":[[[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}]],[[],[{"range":[29,30],"categories":["program"],"children":[]}]],[[],[{"range":[30,56],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}]],[[{"range":[29,29],"categories":["program"],"children":[]}],[{"range":[56,56],"categories":["program"],"children":[]}]]],"oids":["",""],"paths":["test/diffs/newline-at-eof.A.js","test/diffs/newline-at-eof.B.js"]} \ No newline at end of file diff --git a/test/diffs/no-newline-at-eof.json.js b/test/diffs/no-newline-at-eof.json.js index 87d59f114..7e25e832a 100644 --- a/test/diffs/no-newline-at-eof.json.js +++ b/test/diffs/no-newline-at-eof.json.js @@ -1 +1 @@ -{"rows":[[[{"range":[0,28],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}]],[[],[{"range":[29,30],"categories":["program"],"children":[]}]],[[],[{"range":[30,55],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}]]]} \ No newline at end of file +{"rows":[[[{"range":[0,28],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}]],[[],[{"range":[29,30],"categories":["program"],"children":[]}]],[[],[{"range":[30,55],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}]]],"oids":["",""],"paths":["test/diffs/no-newline-at-eof.A.js","test/diffs/no-newline-at-eof.B.js"]} \ No newline at end of file From 530466364285079251b411638a2de6acf3487b9d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:40:44 -0500 Subject: [PATCH 130/149] Format the top level pairs across several lines. --- src/Renderer/JSON.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 3c4873e92..67952c1ed 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -28,7 +28,10 @@ import Term -- | Render a diff to a string representing its JSON. json :: Renderer a ByteString -json diff sources = toLazyByteString . fromEncoding $ pairs ("rows" .= Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources)) <> "oids" .= (oid <$> sources) <> "paths" .= (path <$> sources)) +json diff sources = toLazyByteString . fromEncoding . pairs $ + "rows" .= Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources)) + <> "oids" .= (oid <$> sources) + <> "paths" .= (path <$> sources) instance ToJSON Category where toJSON (Other s) = String $ T.pack s From 94f97ba36658ff8478a96364b5d062f14291257d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:42:14 -0500 Subject: [PATCH 131/149] Unpack the rows. --- src/Renderer/JSON.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 67952c1ed..8f11fb2b3 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -29,9 +29,10 @@ import Term -- | Render a diff to a string representing its JSON. json :: Renderer a ByteString json diff sources = toLazyByteString . fromEncoding . pairs $ - "rows" .= Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources)) + "rows" .= annotateRows (Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources))) <> "oids" .= (oid <$> sources) <> "paths" .= (path <$> sources) + where annotateRows = fmap unRow instance ToJSON Category where toJSON (Other s) = String $ T.pack s From 607d90336e0a49a06ed67faa94877c58c6f55cf6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 14:42:50 -0500 Subject: [PATCH 132/149] Remove the ToJSON instance for Row. --- src/Renderer/JSON.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 8f11fb2b3..54440c7dd 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -40,9 +40,6 @@ instance ToJSON Category where instance ToJSON Range where toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ] toEncoding (Range start end) = foldable [ start, end ] -instance ToJSON a => ToJSON (Row a) where - toJSON (Row both) = toJSON both - toEncoding (Row both) = toEncoding both instance ToJSON a => ToJSON (Line a) where toJSON = Array . fromList . fmap toJSON . unLine toEncoding = foldable . unLine From 7775554d5947a7825575369fb12c01f72015ffcd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 15:22:10 -0500 Subject: [PATCH 133/149] Explicitly unwrap the lines. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 54440c7dd..7e2ae4081 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -32,7 +32,7 @@ json diff sources = toLazyByteString . fromEncoding . pairs $ "rows" .= annotateRows (Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources))) <> "oids" .= (oid <$> sources) <> "paths" .= (path <$> sources) - where annotateRows = fmap unRow + where annotateRows = fmap (fmap (fromList . unLine) . unRow) instance ToJSON Category where toJSON (Other s) = String $ T.pack s From 655f14186fa6ff417281a9b223e6e0e42aa867a6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 15:22:39 -0500 Subject: [PATCH 134/149] Remove the ToJSON instance for Line. --- src/Renderer/JSON.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 7e2ae4081..87fe27b1e 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -40,9 +40,6 @@ instance ToJSON Category where instance ToJSON Range where toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ] toEncoding (Range start end) = foldable [ start, end ] -instance ToJSON a => ToJSON (Line a) where - toJSON = Array . fromList . fmap toJSON . unLine - toEncoding = foldable . unLine instance ToJSON a => ToJSON (Both a) where toJSON (Both (a, b)) = Array . fromList $ toJSON <$> [ a, b ] toEncoding both = foldable both From ede7895bf95a29a134d0e681bd68fa21aedf7d87 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 16:29:42 -0500 Subject: [PATCH 135/149] Move numberedRows into the Alignment module. --- src/Alignment.hs | 9 +++++++++ src/Renderer/Split.hs | 11 +---------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Alignment.hs b/src/Alignment.hs index bf73c2929..3236e0889 100644 --- a/src/Alignment.hs +++ b/src/Alignment.hs @@ -4,6 +4,7 @@ import Category import Control.Comonad.Cofree import Control.Monad.Free import Data.Either +import Data.Foldable (foldl') import Data.Functor.Both import Data.Functor.Identity import qualified Data.OrderedMap as Map @@ -20,6 +21,14 @@ import SplitDiff import Syntax import Term +-- | Assign line numbers to the lines on each side of a list of rows. +numberedRows :: [Row a] -> [Both (Int, Line a)] +numberedRows = foldl' numberRows [] + where numberRows rows row = ((,) <$> ((+) <$> count rows <*> (valueOf <$> unRow row)) <*> unRow row) : rows + count = maybe (pure 0) (fmap Prelude.fst) . maybeFirst + valueOf EmptyLine = 0 + valueOf _ = 1 + -- | Split a diff, which may span multiple lines, into rows of split diffs. splitDiffByLines :: Diff leaf Info -> Both Int -> Both (Source Char) -> ([Row (SplitDiff leaf Info)], Both Range) splitDiffByLines diff previous sources = case diff of diff --git a/src/Renderer/Split.hs b/src/Renderer/Split.hs index 22c977820..4e4b476f3 100644 --- a/src/Renderer/Split.hs +++ b/src/Renderer/Split.hs @@ -15,7 +15,6 @@ import Line import Prelude hiding (div, head, span, fst, snd) import qualified Prelude import Range -import Row import Renderer import Source hiding ((++)) import SplitDiff @@ -65,7 +64,7 @@ split diff blobs = renderHtml where sources = Source.source <$> blobs rows = Prelude.fst (splitDiffByLines diff (pure 0) sources) - numbered = foldl' numberRows [] rows + numbered = numberedRows rows maxNumber = case numbered of [] -> 0 (row : _) -> runBothWith max $ Prelude.fst <$> row @@ -86,14 +85,6 @@ split diff blobs = renderHtml hasChanges diff = or $ const True <$> diff - -- | Add a row to list of tuples of ints and lines, where the ints denote - -- | how many non-empty lines exist on that side up to that point. - numberRows :: [Both (Int, Line a)] -> Row a -> [Both (Int, Line a)] - numberRows rows row = ((,) <$> ((+) <$> count rows <*> (valueOf <$> unRow row)) <*> unRow row) : rows - where count = maybe (pure 0) (fmap Prelude.fst) . maybeFirst - valueOf EmptyLine = 0 - valueOf _ = 1 - -- | Something that can be rendered as markup. newtype Renderable a = Renderable a From d4efc9e7d5c7ba76711bc0af5baed02c77abd422 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 16:32:02 -0500 Subject: [PATCH 136/149] Remove a diff in a format we no longer support. --- test/diffs/dictionary.unified.js | 4 ---- 1 file changed, 4 deletions(-) delete mode 100644 test/diffs/dictionary.unified.js diff --git a/test/diffs/dictionary.unified.js b/test/diffs/dictionary.unified.js deleted file mode 100644 index ac8821460..000000000 --- a/test/diffs/dictionary.unified.js +++ /dev/null @@ -1,4 +0,0 @@ -{ - "b": {-4-}{+5+}, - "a": 5 -} From 2f472704004f86289b248b2133f735a7eacbdd4c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Mar 2016 16:32:08 -0500 Subject: [PATCH 137/149] Add a split diff fixture. --- test/diffs/dictionary.split.js | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 test/diffs/dictionary.split.js diff --git a/test/diffs/dictionary.split.js b/test/diffs/dictionary.split.js new file mode 100644 index 000000000..9738b3985 --- /dev/null +++ b/test/diffs/dictionary.split.js @@ -0,0 +1,25 @@ + + + + + + + + + + + + + + + + +
1
    • { +
1
    • { +
2
        • "
        • b
        • "
      • :
      • 4
      , +
2
        • "
        • b
        • "
      • :
      • 5
      , +
3
        • "
        • a
        • "
      • :
      • 5
      +
3
        • "
        • a
        • "
      • :
      • 5
      +
4
    • }
    • +
4
    • }
    • +
5
    5
      \ No newline at end of file From e7d6c122f77a880c9c7873cc9c6e2193de06de0d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 07:49:04 -0500 Subject: [PATCH 138/149] Number lines. --- src/Renderer/JSON.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 87fe27b1e..a4b18f6b0 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -20,7 +20,6 @@ import Diff import Line import Range import Renderer -import Row import Source hiding (fromList, toList) import SplitDiff import Syntax @@ -32,8 +31,13 @@ json diff sources = toLazyByteString . fromEncoding . pairs $ "rows" .= annotateRows (Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources))) <> "oids" .= (oid <$> sources) <> "paths" .= (path <$> sources) - where annotateRows = fmap (fmap (fromList . unLine) . unRow) + where annotateRows = fmap (fmap NumberedLine) . Prelude.reverse . numberedRows +newtype NumberedLine a = NumberedLine (Int, Line a) + +instance ToJSON a => ToJSON (NumberedLine a) where + toJSON (NumberedLine (n, a)) = object [ "number" .= n, "terms" .= unLine a ] + toEncoding (NumberedLine (n, a)) = pairs ("number" .= n <> "terms" .= unLine a) instance ToJSON Category where toJSON (Other s) = String $ T.pack s toJSON s = String . T.pack $ show s From 8bc5ef427a96cacaef7cfab7453ffb8e103775cc Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 07:53:26 -0500 Subject: [PATCH 139/149] Extract the line fields into a function. --- src/Renderer/JSON.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index a4b18f6b0..ea9b73401 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -36,8 +36,8 @@ json diff sources = toLazyByteString . fromEncoding . pairs $ newtype NumberedLine a = NumberedLine (Int, Line a) instance ToJSON a => ToJSON (NumberedLine a) where - toJSON (NumberedLine (n, a)) = object [ "number" .= n, "terms" .= unLine a ] - toEncoding (NumberedLine (n, a)) = pairs ("number" .= n <> "terms" .= unLine a) + toJSON (NumberedLine (n, a)) = object (lineFields n a) + toEncoding (NumberedLine (n, a)) = pairs $ mconcat (lineFields n a) instance ToJSON Category where toJSON (Other s) = String $ T.pack s toJSON s = String . T.pack $ show s @@ -59,6 +59,9 @@ instance ToJSON (Term leaf Info) where toJSON (info :< syntax) = object (termFields info syntax) toEncoding (info :< syntax) = pairs $ mconcat (termFields info syntax) +lineFields :: (ToJSON a, KeyValue kv) => Int -> Line a -> [kv] +lineFields n line = [ "number" .= n, "terms" .= unLine line ] + termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] termFields (Info range categories) syntax = "range" .= range : "categories" .= categories : case syntax of Leaf _ -> [] From dbeb71fb613cd729d66b34bbe5dfe8477e6b27d9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 08:01:11 -0500 Subject: [PATCH 140/149] Use <$ to determine if a diff has changes. --- src/Renderer/Split.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/Split.hs b/src/Renderer/Split.hs index 4e4b476f3..b7f1ac0d4 100644 --- a/src/Renderer/Split.hs +++ b/src/Renderer/Split.hs @@ -83,7 +83,7 @@ split diff blobs = renderHtml renderLine :: (Int, Line (SplitDiff leaf Info)) -> Source Char -> Markup renderLine (number, line) source = toMarkup $ Renderable (or $ hasChanges <$> line, number, Renderable . (,) source <$> line) - hasChanges diff = or $ const True <$> diff + hasChanges diff = or $ True <$ diff -- | Something that can be rendered as markup. newtype Renderable a = Renderable a From a97fd599df450b25049c5c16d4a165d0c293f7ff Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 08:03:49 -0500 Subject: [PATCH 141/149] Rewrite hasChanges to operate on a whole line. --- src/Renderer/Split.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Renderer/Split.hs b/src/Renderer/Split.hs index b7f1ac0d4..d94368402 100644 --- a/src/Renderer/Split.hs +++ b/src/Renderer/Split.hs @@ -81,9 +81,10 @@ split diff blobs = renderHtml numberedLinesToMarkup numberedLines = tr $ (runBothWith (<>) (renderLine <$> numberedLines <*> sources)) <> string "\n" renderLine :: (Int, Line (SplitDiff leaf Info)) -> Source Char -> Markup - renderLine (number, line) source = toMarkup $ Renderable (or $ hasChanges <$> line, number, Renderable . (,) source <$> line) + renderLine (number, line) source = toMarkup $ Renderable (hasChanges line, number, Renderable . (,) source <$> line) - hasChanges diff = or $ True <$ diff + hasChanges :: Line (SplitDiff leaf Info) -> Bool + hasChanges = or . fmap (or . (True <$)) -- | Something that can be rendered as markup. newtype Renderable a = Renderable a From a34d31f97d0f6b57c89b90cbba535160d5fca2af Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 08:04:17 -0500 Subject: [PATCH 142/149] Add a hasChanges field. --- src/Renderer/JSON.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index ea9b73401..ca09b6da0 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -35,7 +35,7 @@ json diff sources = toLazyByteString . fromEncoding . pairs $ newtype NumberedLine a = NumberedLine (Int, Line a) -instance ToJSON a => ToJSON (NumberedLine a) where +instance ToJSON (NumberedLine (SplitDiff leaf Info)) where toJSON (NumberedLine (n, a)) = object (lineFields n a) toEncoding (NumberedLine (n, a)) = pairs $ mconcat (lineFields n a) instance ToJSON Category where @@ -59,8 +59,8 @@ instance ToJSON (Term leaf Info) where toJSON (info :< syntax) = object (termFields info syntax) toEncoding (info :< syntax) = pairs $ mconcat (termFields info syntax) -lineFields :: (ToJSON a, KeyValue kv) => Int -> Line a -> [kv] -lineFields n line = [ "number" .= n, "terms" .= unLine line ] +lineFields :: KeyValue kv => Int -> Line (SplitDiff leaf Info) -> [kv] +lineFields n line = [ "number" .= n, "terms" .= unLine line, "hasChanges" .= Prelude.or (Prelude.or . (True <$) <$> line) ] termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] termFields (Info range categories) syntax = "range" .= range : "categories" .= categories : case syntax of From ced884d79b3d9920b961bc8476045a99cdf00ec0 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 08:05:18 -0500 Subject: [PATCH 143/149] Move hasChanges into the Alignment module. --- src/Alignment.hs | 4 ++++ src/Renderer/Split.hs | 3 --- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Alignment.hs b/src/Alignment.hs index 3236e0889..ba4ceff95 100644 --- a/src/Alignment.hs +++ b/src/Alignment.hs @@ -29,6 +29,10 @@ numberedRows = foldl' numberRows [] valueOf EmptyLine = 0 valueOf _ = 1 +-- | Determine whether a line contains any patches. +hasChanges :: Line (SplitDiff leaf Info) -> Bool +hasChanges = or . fmap (or . (True <$)) + -- | Split a diff, which may span multiple lines, into rows of split diffs. splitDiffByLines :: Diff leaf Info -> Both Int -> Both (Source Char) -> ([Row (SplitDiff leaf Info)], Both Range) splitDiffByLines diff previous sources = case diff of diff --git a/src/Renderer/Split.hs b/src/Renderer/Split.hs index d94368402..6d96cae2d 100644 --- a/src/Renderer/Split.hs +++ b/src/Renderer/Split.hs @@ -83,9 +83,6 @@ split diff blobs = renderHtml renderLine :: (Int, Line (SplitDiff leaf Info)) -> Source Char -> Markup renderLine (number, line) source = toMarkup $ Renderable (hasChanges line, number, Renderable . (,) source <$> line) - hasChanges :: Line (SplitDiff leaf Info) -> Bool - hasChanges = or . fmap (or . (True <$)) - -- | Something that can be rendered as markup. newtype Renderable a = Renderable a From 5eaa843abcade8e4ebf01653367a6cc980480a9a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 08:05:53 -0500 Subject: [PATCH 144/149] Use hasChanges in the JSON. --- src/Renderer/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index ca09b6da0..fa5e5e589 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -60,7 +60,7 @@ instance ToJSON (Term leaf Info) where toEncoding (info :< syntax) = pairs $ mconcat (termFields info syntax) lineFields :: KeyValue kv => Int -> Line (SplitDiff leaf Info) -> [kv] -lineFields n line = [ "number" .= n, "terms" .= unLine line, "hasChanges" .= Prelude.or (Prelude.or . (True <$) <$> line) ] +lineFields n line = [ "number" .= n, "terms" .= unLine line, "hasChanges" .= hasChanges line ] termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] termFields (Info range categories) syntax = "range" .= range : "categories" .= categories : case syntax of From d5f9b170d47a5fcd44a8af72e5e2f0ec4105d904 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 08:16:27 -0500 Subject: [PATCH 145/149] Line JSON contains the range of all the diffs on the line. --- src/Renderer/JSON.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index fa5e5e589..1e084f6d1 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -60,7 +60,9 @@ instance ToJSON (Term leaf Info) where toEncoding (info :< syntax) = pairs $ mconcat (termFields info syntax) lineFields :: KeyValue kv => Int -> Line (SplitDiff leaf Info) -> [kv] -lineFields n line = [ "number" .= n, "terms" .= unLine line, "hasChanges" .= hasChanges line ] +lineFields n line = [ "number" .= n, "terms" .= unLine line, "range" .= unionRanges (getRange <$> line), "hasChanges" .= hasChanges line ] + where getRange (Free (Annotated (Info range _) _)) = range + getRange (Pure patch) = case getSplitTerm patch of Info range _ :< _ -> range termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] termFields (Info range categories) syntax = "range" .= range : "categories" .= categories : case syntax of From 3f7cdf88a77047ea9855d5caeb07b2cef8db57b9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 08:18:25 -0500 Subject: [PATCH 146/149] Regenerate the JSON fixtures. --- test/diffs/dictionary.json.js | 2 +- test/diffs/newline-at-eof.json.js | 2 +- test/diffs/no-newline-at-eof.json.js | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/diffs/dictionary.json.js b/test/diffs/dictionary.json.js index 29fefa96f..0fd2f4ee8 100644 --- a/test/diffs/dictionary.json.js +++ b/test/diffs/dictionary.json.js @@ -1 +1 @@ -{"rows":[[[{"range":[0,2],"categories":["program"],"children":[{"range":[0,2],"categories":["expression_statement"],"children":[{"range":[0,2],"categories":["DictionaryLiteral"],"children":{}}]}]}],[{"range":[0,2],"categories":["program"],"children":[{"range":[0,2],"categories":["expression_statement"],"children":[{"range":[0,2],"categories":["DictionaryLiteral"],"children":{}}]}]}]],[[{"range":[2,12],"categories":["program"],"children":[{"range":[2,12],"categories":["expression_statement"],"children":[{"range":[2,12],"categories":["DictionaryLiteral"],"children":{"\"b\"":{"range":[4,10],"categories":["Pair"],"children":[{"range":[4,7],"categories":["StringLiteral"],"children":[{"range":[4,5],"categories":["StringLiteral"]},{"range":[5,6],"categories":["StringLiteral"]},{"range":[6,7],"categories":["StringLiteral"]}]},{"patch":"replace","range":[9,10],"categories":["number"]}]}}}]}]}],[{"range":[2,12],"categories":["program"],"children":[{"range":[2,12],"categories":["expression_statement"],"children":[{"range":[2,12],"categories":["DictionaryLiteral"],"children":{"\"b\"":{"range":[4,10],"categories":["Pair"],"children":[{"range":[4,7],"categories":["StringLiteral"],"children":[{"range":[4,5],"categories":["StringLiteral"]},{"range":[5,6],"categories":["StringLiteral"]},{"range":[6,7],"categories":["StringLiteral"]}]},{"patch":"replace","range":[9,10],"categories":["number"]}]}}}]}]}]],[[{"range":[12,21],"categories":["program"],"children":[{"range":[12,21],"categories":["expression_statement"],"children":[{"range":[12,21],"categories":["DictionaryLiteral"],"children":{"\"a\"":{"range":[14,20],"categories":["Pair"],"children":[{"range":[14,17],"categories":["StringLiteral"],"children":[{"range":[14,15],"categories":["StringLiteral"]},{"range":[15,16],"categories":["StringLiteral"]},{"range":[16,17],"categories":["StringLiteral"]}]},{"range":[19,20],"categories":["number"]}]}}}]}]}],[{"range":[12,21],"categories":["program"],"children":[{"range":[12,21],"categories":["expression_statement"],"children":[{"range":[12,21],"categories":["DictionaryLiteral"],"children":{"\"a\"":{"range":[14,20],"categories":["Pair"],"children":[{"range":[14,17],"categories":["StringLiteral"],"children":[{"range":[14,15],"categories":["StringLiteral"]},{"range":[15,16],"categories":["StringLiteral"]},{"range":[16,17],"categories":["StringLiteral"]}]},{"range":[19,20],"categories":["number"]}]}}}]}]}]],[[{"range":[21,23],"categories":["program"],"children":[{"range":[21,23],"categories":["expression_statement"],"children":[{"range":[21,22],"categories":["DictionaryLiteral"],"children":{}}]}]}],[{"range":[21,23],"categories":["program"],"children":[{"range":[21,23],"categories":["expression_statement"],"children":[{"range":[21,22],"categories":["DictionaryLiteral"],"children":{}}]}]}]],[[{"range":[23,23],"categories":["program"],"children":[{"range":[23,23],"categories":["expression_statement"],"children":[]}]}],[{"range":[23,23],"categories":["program"],"children":[{"range":[23,23],"categories":["expression_statement"],"children":[]}]}]]],"oids":["",""],"paths":["test/diffs/dictionary.A.js","test/diffs/dictionary.B.js"]} \ No newline at end of file +{"rows":[[{"number":1,"terms":[{"range":[0,2],"categories":["program"],"children":[{"range":[0,2],"categories":["expression_statement"],"children":[{"range":[0,2],"categories":["DictionaryLiteral"],"children":{}}]}]}],"range":[0,2],"hasChanges":false},{"number":1,"terms":[{"range":[0,2],"categories":["program"],"children":[{"range":[0,2],"categories":["expression_statement"],"children":[{"range":[0,2],"categories":["DictionaryLiteral"],"children":{}}]}]}],"range":[0,2],"hasChanges":false}],[{"number":2,"terms":[{"range":[2,12],"categories":["program"],"children":[{"range":[2,12],"categories":["expression_statement"],"children":[{"range":[2,12],"categories":["DictionaryLiteral"],"children":{"\"b\"":{"range":[4,10],"categories":["Pair"],"children":[{"range":[4,7],"categories":["StringLiteral"],"children":[{"range":[4,5],"categories":["StringLiteral"]},{"range":[5,6],"categories":["StringLiteral"]},{"range":[6,7],"categories":["StringLiteral"]}]},{"patch":"replace","range":[9,10],"categories":["number"]}]}}}]}]}],"range":[2,12],"hasChanges":true},{"number":2,"terms":[{"range":[2,12],"categories":["program"],"children":[{"range":[2,12],"categories":["expression_statement"],"children":[{"range":[2,12],"categories":["DictionaryLiteral"],"children":{"\"b\"":{"range":[4,10],"categories":["Pair"],"children":[{"range":[4,7],"categories":["StringLiteral"],"children":[{"range":[4,5],"categories":["StringLiteral"]},{"range":[5,6],"categories":["StringLiteral"]},{"range":[6,7],"categories":["StringLiteral"]}]},{"patch":"replace","range":[9,10],"categories":["number"]}]}}}]}]}],"range":[2,12],"hasChanges":true}],[{"number":3,"terms":[{"range":[12,21],"categories":["program"],"children":[{"range":[12,21],"categories":["expression_statement"],"children":[{"range":[12,21],"categories":["DictionaryLiteral"],"children":{"\"a\"":{"range":[14,20],"categories":["Pair"],"children":[{"range":[14,17],"categories":["StringLiteral"],"children":[{"range":[14,15],"categories":["StringLiteral"]},{"range":[15,16],"categories":["StringLiteral"]},{"range":[16,17],"categories":["StringLiteral"]}]},{"range":[19,20],"categories":["number"]}]}}}]}]}],"range":[12,21],"hasChanges":false},{"number":3,"terms":[{"range":[12,21],"categories":["program"],"children":[{"range":[12,21],"categories":["expression_statement"],"children":[{"range":[12,21],"categories":["DictionaryLiteral"],"children":{"\"a\"":{"range":[14,20],"categories":["Pair"],"children":[{"range":[14,17],"categories":["StringLiteral"],"children":[{"range":[14,15],"categories":["StringLiteral"]},{"range":[15,16],"categories":["StringLiteral"]},{"range":[16,17],"categories":["StringLiteral"]}]},{"range":[19,20],"categories":["number"]}]}}}]}]}],"range":[12,21],"hasChanges":false}],[{"number":4,"terms":[{"range":[21,23],"categories":["program"],"children":[{"range":[21,23],"categories":["expression_statement"],"children":[{"range":[21,22],"categories":["DictionaryLiteral"],"children":{}}]}]}],"range":[21,23],"hasChanges":false},{"number":4,"terms":[{"range":[21,23],"categories":["program"],"children":[{"range":[21,23],"categories":["expression_statement"],"children":[{"range":[21,22],"categories":["DictionaryLiteral"],"children":{}}]}]}],"range":[21,23],"hasChanges":false}],[{"number":5,"terms":[{"range":[23,23],"categories":["program"],"children":[{"range":[23,23],"categories":["expression_statement"],"children":[]}]}],"range":[23,23],"hasChanges":false},{"number":5,"terms":[{"range":[23,23],"categories":["program"],"children":[{"range":[23,23],"categories":["expression_statement"],"children":[]}]}],"range":[23,23],"hasChanges":false}]],"oids":["",""],"paths":["test/diffs/dictionary.A.js","test/diffs/dictionary.B.js"]} \ No newline at end of file diff --git a/test/diffs/newline-at-eof.json.js b/test/diffs/newline-at-eof.json.js index 3fc48cf61..1d0612403 100644 --- a/test/diffs/newline-at-eof.json.js +++ b/test/diffs/newline-at-eof.json.js @@ -1 +1 @@ -{"rows":[[[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}]],[[],[{"range":[29,30],"categories":["program"],"children":[]}]],[[],[{"range":[30,56],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}]],[[{"range":[29,29],"categories":["program"],"children":[]}],[{"range":[56,56],"categories":["program"],"children":[]}]]],"oids":["",""],"paths":["test/diffs/newline-at-eof.A.js","test/diffs/newline-at-eof.B.js"]} \ No newline at end of file +{"rows":[[{"number":1,"terms":[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,29],"hasChanges":false},{"number":1,"terms":[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,29],"hasChanges":false}],[{"number":1,"terms":[],"range":[0,0],"hasChanges":false},{"number":2,"terms":[{"range":[29,30],"categories":["program"],"children":[]}],"range":[29,30],"hasChanges":false}],[{"number":1,"terms":[],"range":[0,0],"hasChanges":false},{"number":3,"terms":[{"range":[30,56],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[30,56],"hasChanges":true}],[{"number":2,"terms":[{"range":[29,29],"categories":["program"],"children":[]}],"range":[29,29],"hasChanges":false},{"number":4,"terms":[{"range":[56,56],"categories":["program"],"children":[]}],"range":[56,56],"hasChanges":false}]],"oids":["",""],"paths":["test/diffs/newline-at-eof.A.js","test/diffs/newline-at-eof.B.js"]} \ No newline at end of file diff --git a/test/diffs/no-newline-at-eof.json.js b/test/diffs/no-newline-at-eof.json.js index 7e25e832a..a8aa684e6 100644 --- a/test/diffs/no-newline-at-eof.json.js +++ b/test/diffs/no-newline-at-eof.json.js @@ -1 +1 @@ -{"rows":[[[{"range":[0,28],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}]],[[],[{"range":[29,30],"categories":["program"],"children":[]}]],[[],[{"range":[30,55],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}]]],"oids":["",""],"paths":["test/diffs/no-newline-at-eof.A.js","test/diffs/no-newline-at-eof.B.js"]} \ No newline at end of file +{"rows":[[{"number":1,"terms":[{"range":[0,28],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,28],"hasChanges":false},{"number":1,"terms":[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,29],"hasChanges":false}],[{"number":1,"terms":[],"range":[0,0],"hasChanges":false},{"number":2,"terms":[{"range":[29,30],"categories":["program"],"children":[]}],"range":[29,30],"hasChanges":false}],[{"number":1,"terms":[],"range":[0,0],"hasChanges":false},{"number":3,"terms":[{"range":[30,55],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[30,55],"hasChanges":true}]],"oids":["",""],"paths":["test/diffs/no-newline-at-eof.A.js","test/diffs/no-newline-at-eof.B.js"]} \ No newline at end of file From d1c2e916285ef97ba6239345f40417cbb3ca9f70 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 08:29:40 -0500 Subject: [PATCH 147/149] Empty lines are truly empty. --- src/Renderer/JSON.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 1e084f6d1..516054aaf 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -60,6 +60,7 @@ instance ToJSON (Term leaf Info) where toEncoding (info :< syntax) = pairs $ mconcat (termFields info syntax) lineFields :: KeyValue kv => Int -> Line (SplitDiff leaf Info) -> [kv] +lineFields _ EmptyLine = [] lineFields n line = [ "number" .= n, "terms" .= unLine line, "range" .= unionRanges (getRange <$> line), "hasChanges" .= hasChanges line ] where getRange (Free (Annotated (Info range _) _)) = range getRange (Pure patch) = case getSplitTerm patch of Info range _ :< _ -> range From ce65a540d29f90e313a246bab7306bbd2bf11202 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 08:30:34 -0500 Subject: [PATCH 148/149] Rebuild the fixtures. --- test/diffs/newline-at-eof.json.js | 2 +- test/diffs/no-newline-at-eof.json.js | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/test/diffs/newline-at-eof.json.js b/test/diffs/newline-at-eof.json.js index 1d0612403..daf8301f9 100644 --- a/test/diffs/newline-at-eof.json.js +++ b/test/diffs/newline-at-eof.json.js @@ -1 +1 @@ -{"rows":[[{"number":1,"terms":[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,29],"hasChanges":false},{"number":1,"terms":[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,29],"hasChanges":false}],[{"number":1,"terms":[],"range":[0,0],"hasChanges":false},{"number":2,"terms":[{"range":[29,30],"categories":["program"],"children":[]}],"range":[29,30],"hasChanges":false}],[{"number":1,"terms":[],"range":[0,0],"hasChanges":false},{"number":3,"terms":[{"range":[30,56],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[30,56],"hasChanges":true}],[{"number":2,"terms":[{"range":[29,29],"categories":["program"],"children":[]}],"range":[29,29],"hasChanges":false},{"number":4,"terms":[{"range":[56,56],"categories":["program"],"children":[]}],"range":[56,56],"hasChanges":false}]],"oids":["",""],"paths":["test/diffs/newline-at-eof.A.js","test/diffs/newline-at-eof.B.js"]} \ No newline at end of file +{"rows":[[{"number":1,"terms":[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,29],"hasChanges":false},{"number":1,"terms":[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,29],"hasChanges":false}],[{},{"number":2,"terms":[{"range":[29,30],"categories":["program"],"children":[]}],"range":[29,30],"hasChanges":false}],[{},{"number":3,"terms":[{"range":[30,56],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[30,56],"hasChanges":true}],[{"number":2,"terms":[{"range":[29,29],"categories":["program"],"children":[]}],"range":[29,29],"hasChanges":false},{"number":4,"terms":[{"range":[56,56],"categories":["program"],"children":[]}],"range":[56,56],"hasChanges":false}]],"oids":["",""],"paths":["test/diffs/newline-at-eof.A.js","test/diffs/newline-at-eof.B.js"]} \ No newline at end of file diff --git a/test/diffs/no-newline-at-eof.json.js b/test/diffs/no-newline-at-eof.json.js index a8aa684e6..eb4963be2 100644 --- a/test/diffs/no-newline-at-eof.json.js +++ b/test/diffs/no-newline-at-eof.json.js @@ -1 +1 @@ -{"rows":[[{"number":1,"terms":[{"range":[0,28],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,28],"hasChanges":false},{"number":1,"terms":[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,29],"hasChanges":false}],[{"number":1,"terms":[],"range":[0,0],"hasChanges":false},{"number":2,"terms":[{"range":[29,30],"categories":["program"],"children":[]}],"range":[29,30],"hasChanges":false}],[{"number":1,"terms":[],"range":[0,0],"hasChanges":false},{"number":3,"terms":[{"range":[30,55],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[30,55],"hasChanges":true}]],"oids":["",""],"paths":["test/diffs/no-newline-at-eof.A.js","test/diffs/no-newline-at-eof.B.js"]} \ No newline at end of file +{"rows":[[{"number":1,"terms":[{"range":[0,28],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,28],"hasChanges":false},{"number":1,"terms":[{"range":[0,29],"categories":["program"],"children":[{"range":[0,28],"categories":["expression_statement"],"children":[{"range":[0,27],"categories":["FunctionCall"],"children":[{"range":[0,11],"categories":["member_access"],"children":[{"range":[0,7],"categories":["identifier"]},{"range":[8,11],"categories":["identifier"]}]},{"range":[12,26],"categories":["arguments"],"children":[{"range":[12,26],"categories":["StringLiteral"],"children":[{"range":[12,13],"categories":["StringLiteral"]},{"range":[13,18],"categories":["StringLiteral"]},{"range":[18,19],"categories":["StringLiteral"]},{"range":[20,25],"categories":["StringLiteral"]},{"range":[25,26],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[0,29],"hasChanges":false}],[{},{"number":2,"terms":[{"range":[29,30],"categories":["program"],"children":[]}],"range":[29,30],"hasChanges":false}],[{},{"number":3,"terms":[{"range":[30,55],"categories":["program"],"children":[{"patch":"insert","range":[30,55],"categories":["expression_statement"],"children":[{"range":[30,54],"categories":["FunctionCall"],"children":[{"range":[30,41],"categories":["member_access"],"children":[{"range":[30,37],"categories":["identifier"]},{"range":[38,41],"categories":["identifier"]}]},{"range":[42,53],"categories":["arguments"],"children":[{"range":[42,53],"categories":["StringLiteral"],"children":[{"range":[42,43],"categories":["StringLiteral"]},{"range":[43,52],"categories":["StringLiteral"]},{"range":[52,53],"categories":["StringLiteral"]}]}]}]}]}]}],"range":[30,55],"hasChanges":true}]],"oids":["",""],"paths":["test/diffs/no-newline-at-eof.A.js","test/diffs/no-newline-at-eof.B.js"]} \ No newline at end of file From ff57f0db46e757fc814886066d5e001279fcb5f0 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 2 Mar 2016 11:52:20 -0500 Subject: [PATCH 149/149] Rename the Annotated field accessors. --- src/Diff.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Diff.hs b/src/Diff.hs index 47706837e..e281f944c 100644 --- a/src/Diff.hs +++ b/src/Diff.hs @@ -10,7 +10,7 @@ import Syntax import Term -- | An annotated syntax in a diff tree. -data Annotated a annotation f = Annotated { getAnnotation :: !annotation, getSyntax :: !(Syntax a f) } +data Annotated a annotation f = Annotated { annotation :: !annotation, syntax :: !(Syntax a f) } deriving (Functor, Eq, Show, Foldable) -- | An annotation for a source file, including the source range and semantic