Merge branch 'master' into go-assignment

.ghci

@@ -0,0 +1,40 @@
+-- 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 (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 r
+:def r \_ -> return (unlines [":reload", ":pretty"])
+
+-- See docs/💡ProTip!.md for documentation & examples.
+:{
+assignmentExample lang = case lang of
+  "Python" -> mk "py" "python"
+  "Go" -> mk "go" "go"
+  "Ruby" -> mk "rb" "ruby"
+  "JavaScript" -> mk "js" "typescript"
+  "TypeScript" -> mk "ts" "typescript"
+  "Haskell" -> mk "hs" "haskell"
+  "Markdown" -> mk "md" "markdown"
+  "JSON" -> mk "json" "json"
+  _ -> mk "" ""
+  where mk fileExtension parser = putStrLn ("example: fmap (() <$) . runTask . parse " ++ parser ++ "Parser =<< Semantic.Util.file \"example." ++ fileExtension ++ "\"") >> return ("import Parser\nimport Semantic.Task\nimport Semantic.Util")
+:}
+:undef assignment
+:def assignment assignmentExample
+
+-- Enable breaking on errors for code written in the repl.
+:seti -fbreak-on-error
+
+-- Continue loading after warnings when in the repl.
+:set -Wwarn
+
+-- Use a cyan lambda as the prompt.
+:set prompt "\ESC[1;36m\STXλ \ESC[m\STX"

.ghci-template

@@ -1,23 +0,0 @@
-:set prompt "\ESC[1;36m\STXλ: \ESC[m\STX"
-
-:def pretty \_ -> return ("import Text.Show.Pretty (pPrint, ppShow)\nimport Language.Haskell.HsColour\nimport Language.Haskell.HsColour.Colourise\nlet color = putStrLn . hscolour TTY defaultColourPrefs False False \"\" False . ppShow\n:set -interactive-print color")
-:def no-pretty \_ -> return (":set -interactive-print System.IO.print")
-
-:def re \_ -> return (":r\n:pretty")
-
-:{
-assignmentExample lang = case lang of
-  "Python" -> mk "py" "python"
-  "Go" -> mk "go" "go"
-  "Ruby" -> mk "rb" "ruby"
-  "JavaScript" -> mk "js" "typescript"
-  "TypeScript" -> mk "ts" "typescript"
-  "Haskell" -> mk "hs" "haskell"
-  "Markdown" -> mk "md" "markdown"
-  "JSON" -> mk "json" "json"
-  _ -> mk "" ""
-  where mk fileExtension parser = putStrLn ("example: fmap (() <$) . runTask . parse " ++ parser ++ "Parser =<< Semantic.Util.file \"example." ++ fileExtension ++ "\"") >> return ("import Parser\nimport Semantic.Task\nimport Semantic.Util")
-:}
-
-:def assignment assignmentExample
-

semantic-diff.cabal

@@ -124,8 +124,6 @@ library
                      , tree-sitter-python
                      , tree-sitter-ruby
                      , tree-sitter-typescript
-                     , pretty-show
-                     , hscolour
   default-language:    Haskell2010
   default-extensions:  DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, RecordWildCards, StrictData
   ghc-options:         -Wall -fno-warn-name-shadowing -O -j

src/Language/TypeScript/Assignment.hs

@@ -544,7 +544,7 @@ forInStatement :: Assignment
 forInStatement = makeTerm <$> symbol ForInStatement <*> children (Statement.ForEach <$> expression <*> expression <*> statement)
 
 doStatement :: Assignment
-doStatement = makeTerm <$> symbol DoStatement <*> children (flip Statement.DoWhile <$> statementBlock <*> parenthesizedExpression)
+doStatement = makeTerm <$> symbol DoStatement <*> children (flip Statement.DoWhile <$> statement <*> parenthesizedExpression)
 
 continueStatement :: Assignment
 continueStatement = makeTerm <$> symbol ContinueStatement <*> children (Statement.Continue <$> ((symbol StatementIdentifier *> identifier) <|> emptyTerm))

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"

src/Semantic/Util.hs

@@ -4,9 +4,6 @@ module Semantic.Util where
 
 import Control.Monad.IO.Class
 import Data.Blob
-import Language.Haskell.HsColour (hscolour, Output(TTY))
-import Language.Haskell.HsColour.Colourise (defaultColourPrefs)
-import Text.Show.Pretty (ppShow)
 import Files
 import Data.Record
 import Data.Functor.Classes
@@ -23,10 +20,6 @@ import Renderer.TOC
 import Data.Range
 import Data.Span
 
--- Produces colorized pretty-printed output for the terminal / GHCi.
-pp :: Show a => a -> IO ()
-pp = putStrLn . hscolour TTY defaultColourPrefs False False "" False . ppShow
-
 file :: MonadIO m => FilePath -> m Blob
 file path = Files.readFile path (languageForFilePath path)
 

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))