Merge remote-tracking branch 'origin/master' into typescript-fixes

.ghci

@@ -1,18 +1,17 @@
--- :source is convenient for (re)loading commands from a file (for example, this one).
-:undef source
-:def source Prelude.readFile
+-- Load the pretty-show & hscolour packages for use with :pretty.
+:set -package pretty-show -package hscolour
 
 -- See docs/💡ProTip!.md
 :undef pretty
-:def pretty \_ -> return "import Text.Show.Pretty (pPrint, ppShow)\nimport Language.Haskell.HsColour\nimport Language.Haskell.HsColour.Colourise\nlet colour = putStrLn . hscolour TTY defaultColourPrefs Prelude.False Prelude.False \"\" Prelude.False . ppShow\n:set -interactive-print colour\n"
+:def pretty \ _ -> return (unlines ["let colour = putStrLn . Language.Haskell.HsColour.hscolour Language.Haskell.HsColour.TTY Language.Haskell.HsColour.Colourise.defaultColourPrefs Prelude.False Prelude.False \"\" Prelude.False . Text.Show.Pretty.ppShow", ":set -interactive-print colour"])
 
 -- See docs/💡ProTip!.md
 :undef no-pretty
 :def no-pretty \_ -> return ":set -interactive-print System.IO.print"
 
 -- See docs/💡ProTip!.md
-:undef re
-:def re \_ -> return ":reload\n:pretty\n"
+:undef r
+:def r \_ -> return (unlines [":reload", ":pretty"])
 
 -- See docs/💡ProTip!.md for documentation & examples.
 :{

src/Parser.hs

@@ -86,7 +86,7 @@ someParser _ Python     = Just (SomeParser pythonParser)
 someParser _ Ruby       = Just (SomeParser rubyParser)
 someParser _ TypeScript = Just (SomeParser typescriptParser)
 
--- | Return a 'Language'-specific 'Parser', if one exists, falling back to the 'LineByLineParser'.
+-- | Return a 'Language'-specific 'Parser', if one exists.
 syntaxParserForLanguage :: Language -> Maybe (Parser (Term Syntax (Record DefaultFields)))
 syntaxParserForLanguage language = case language of
   Go         -> Just (TreeSitterParser tree_sitter_go)

src/Renderer/TOC.hs

@@ -226,8 +226,7 @@ formatTOCError e = showExpectation False (errorExpected e) (errorActual e) ""
 
 -- | An entry in a table of contents.
 data Entry a
-  = Unchanged { entryPayload :: a } -- ^ An entry for an unchanged portion of a diff (i.e. a diff node not containing any patches).
-  | Changed   { entryPayload :: a } -- ^ An entry for a node containing changes.
+  = Changed   { entryPayload :: a } -- ^ An entry for a node containing changes.
   | Inserted  { entryPayload :: a } -- ^ An entry for a change occurring inside an 'Insert' 'Patch'.
   | Deleted   { entryPayload :: a } -- ^ An entry for a change occurring inside a 'Delete' 'Patch'.
   | Replaced  { entryPayload :: a } -- ^ An entry for a change occurring on the insertion side of a 'Replace' 'Patch'.
@@ -238,13 +237,12 @@ data Entry a
 tableOfContentsBy :: (Foldable f, Functor f)
                   => (forall b. TermF f ann b -> Maybe a) -- ^ A function mapping relevant nodes onto values in Maybe.
                   -> Diff f ann ann                       -- ^ The diff to compute the table of contents for.
-                  -> [Entry a]                            -- ^ A list of entries for relevant changed and unchanged nodes in the diff.
+                  -> [Entry a]                            -- ^ A list of entries for relevant changed nodes in the diff.
 tableOfContentsBy selector = fromMaybe [] . cata (\ r -> case r of
   Patch patch -> (pure . patchEntry <$> bicrosswalk selector selector patch) <> bifoldMap fold fold patch <> Just []
   Merge (In (_, ann2) r) -> case (selector (In ann2 r), fold r) of
-    (Just a, Nothing) -> Just [Unchanged a]
-    (Just a, Just []) -> Just [Changed a]
-    (_     , entries) -> entries)
+    (Just a, Just entries) -> Just (Changed a : entries)
+    (_     , entries)      -> entries)
 
   where patchEntry = patch Deleted Inserted (const Replaced)
 
@@ -284,10 +282,9 @@ dedupe = let tuples = sortOn fst . Map.elems . snd . foldl' go (0, Map.empty) in
     dedupeKey entry = DedupeKey ((fmap toCategoryName . getDeclaration . entryPayload) entry, (fmap (toLower . declarationIdentifier) . getDeclaration . entryPayload) entry)
     exactMatch = (==) `on` (getDeclaration . entryPayload)
 
--- | Construct a 'JSONSummary' from an 'Entry'. Returns 'Nothing' for 'Unchanged' patches.
+-- | Construct a 'JSONSummary' from an 'Entry'.
 entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Entry (Record fields) -> Maybe JSONSummary
 entrySummary entry = case entry of
-  Unchanged _ -> Nothing
   Changed a   -> recordSummary a "modified"
   Deleted a   -> recordSummary a "removed"
   Inserted a  -> recordSummary a "added"

test/TOCSpec.hs

@@ -10,6 +10,7 @@ import Data.ByteString (ByteString)
 import Data.Diff
 import Data.Functor.Both
 import Data.Functor.Listable
+import Data.Functor.Foldable (cata)
 import Data.Maybe (fromMaybe)
 import Data.Monoid (Last(..))
 import Data.Output
@@ -44,13 +45,8 @@ spec = parallel $ do
     prop "drops all nodes with the constant Nothing function" $
       \ diff -> tableOfContentsBy (const Nothing :: a -> Maybe ()) (diff :: Diff Syntax () ()) `shouldBe` []
 
-    let diffSize = max 1 . length . diffPatches
-    let lastValue a = fromMaybe (extract a) (getLast (foldMap (Last . Just) a))
-    prop "includes all nodes with a constant Just function" $
-      \ diff -> let diff' = (diff :: Diff Syntax () ()) in entryPayload <$> tableOfContentsBy (const (Just ())) diff' `shouldBe` replicate (diffSize diff') ()
-
-    prop "produces an unchanged entry for identity diffs" $
-      \ term -> tableOfContentsBy (Just . termAnnotation) (diffSyntaxTerms term term) `shouldBe` [Unchanged (lastValue (term :: Term Syntax (Record '[Category])))]
+    prop "produces no entries for identity diffs" $
+      \ term -> tableOfContentsBy (Just . termAnnotation) (diffSyntaxTerms term (term :: Term Syntax (Record '[Category]))) `shouldBe` []
 
     prop "produces inserted/deleted/replaced entries for relevant nodes within patches" $
       \ p -> tableOfContentsBy (Just . termAnnotation) (patch deleting inserting replacing p)
@@ -60,8 +56,7 @@ spec = parallel $ do
     prop "produces changed entries for relevant nodes containing irrelevant patches" $
       \ diff -> let diff' = merge (0, 0) (Indexed [bimap (const 1) (const 1) (diff :: Diff Syntax Int Int)]) in
         tableOfContentsBy (\ (n `In` _) -> if n == (0 :: Int) then Just n else Nothing) diff' `shouldBe`
-        if null (diffPatches diff') then [Unchanged 0]
-                                    else replicate (length (diffPatches diff')) (Changed 0)
+        replicate (length (diffPatches diff')) (Changed 0)
 
   describe "diffTOC" $ do
     it "blank if there are no methods" $
@@ -167,7 +162,7 @@ spec = parallel $ do
     it "summarizes Markdown headings" $ do
       blobs <- blobsForPaths (both "markdown/headings.A.md" "markdown/headings.B.md")
       output <- runTask (diffBlobPair ToCDiffRenderer blobs)
-      toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[5,1],\"end\":[7,10]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"added\"},{\"span\":{\"start\":[9,1],\"end\":[10,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString)
+      toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[1,1],\"end\":[7,10]},\"category\":\"Heading 1\",\"term\":\"One\",\"changeType\":\"modified\"},{\"span\":{\"start\":[5,1],\"end\":[7,10]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"added\"},{\"span\":{\"start\":[9,1],\"end\":[10,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString)
 
 
 type Diff' = Diff Syntax (Record (Maybe Declaration ': DefaultFields)) (Record (Maybe Declaration ': DefaultFields))

vendor/effects

@@ -1 +1 @@
-Subproject commit a1351b26a557cec1f7a87d5f6563189329f4f450
+Subproject commit 82de1945a13e7c9b14c6eae00425869e6ba1efd2