Merge branch 'master' into factor-git-integration-into-a-separate-package

# Conflicts:
#	semantic-diff.cabal

semantic-diff.cabal

@@ -28,7 +28,6 @@ library
                      , Renderer
                      , Renderer.Patch
                      , Renderer.Split
-                     , Renderer.Unified
                      , SES
                      , Category
                      , Term
@@ -38,8 +37,9 @@ library
                      , Source
                      , Control.Monad.Free
                      , Control.Comonad.Cofree
+                     , Data.Bifunctor.Join
+                     , Data.Option
   build-depends:       base >= 4.8 && < 5
-                     , bifunctors
                      , blaze-html
                      , blaze-markup
                      , bytestring
@@ -48,8 +48,6 @@ library
                      , directory
                      , filepath
                      , mtl
-                     , rainbow
-                     , semigroups
                      , text >= 1.2.1.3
                      , text-icu
                      , tree-sitter-parsers
@@ -70,7 +68,6 @@ test-suite semantic-diff-test
                      , SplitSpec
                      , TermSpec
   build-depends:       base
-                     , bifunctors
                      , bytestring
                      , containers
                      , deepseq
@@ -78,7 +75,6 @@ test-suite semantic-diff-test
                      , Glob
                      , hspec >= 2.1.10
                      , QuickCheck >= 2.8.1
-                     , rainbow
                      , semantic-diff
                      , text >= 1.2.1.3
                      , quickcheck-text

src/Data/Bifunctor/Join.hs

@@ -0,0 +1,8 @@
+module Data.Bifunctor.Join where
+
+newtype Join a = Join { runJoin :: (a, a) }
+  deriving (Eq, Show, Functor, Foldable, Traversable)
+
+instance Applicative Join where
+  pure a = Join (a, a)
+  Join (f, g) <*> Join (a, b) = Join (f a, g b)

src/Data/Option.hs

@@ -0,0 +1,6 @@
+module Data.Option where
+
+newtype Option a = Option { getOption :: Maybe a }
+
+option :: b -> (a -> b) -> Option a -> b
+option b f = maybe b f . getOption

src/DiffOutput.hs

@@ -10,22 +10,15 @@ import qualified System.IO as IO
 import qualified Data.Text.Lazy.IO as TextIO
 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 = Split | Patch
 
 data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath, outputPath :: FilePath }
 
 -- | Return a renderer from the command-line arguments that will print the diff.
 printDiff :: Parser -> DiffArguments -> (SourceBlob, SourceBlob) -> IO ()
 printDiff parser arguments sources = case format arguments of
-  Unified -> put =<< diffFiles parser unified sources
-    where
-      put chunks = do
-        renderer <- byteStringMakerFromEnvironment
-        B1.putStr $ mconcat $ chunksToByteStrings renderer chunks
   Split -> put (output arguments) =<< diffFiles parser split sources
     where
       put Nothing rendered = TextIO.putStr rendered

src/Range.hs

@@ -5,7 +5,7 @@ import qualified Data.Text as T
 import Control.Applicative ((<|>))
 import qualified Data.Char as Char
 import Data.Maybe (fromMaybe)
-import Data.Semigroup
+import Data.Option
 
 -- | A half-open interval of integers, defined by start & end indices.
 data Range = Range { start :: !Int, end :: !Int }
@@ -64,8 +64,12 @@ unionRange (Range start1 end1) (Range start2 end2) = Range (min start1 start2) (
 unionRanges :: (Functor f, Foldable f) => f Range -> Range
 unionRanges ranges = option (Range 0 0) id . foldl mappend mempty $ Option . Just <$> ranges
 
-instance Semigroup Range where
+instance Monoid (Option Range) where
-  (<>) = unionRange
+  mempty = Option Nothing
+  mappend (Option (Just a)) (Option (Just b)) = Option (Just (unionRange a b))
+  mappend a@(Option (Just _)) _ = a
+  mappend _ b@(Option (Just _)) = b
+  mappend _ _ = mempty
 
 instance Ord Range where
   a <= b = start a <= start b

src/Renderer/Unified.hs

@@ -1,58 +0,0 @@
-module Renderer.Unified (unified, substring) where
-
-import Diff
-import Patch
-import Syntax
-import Term
-import Range
-import Renderer
-import Source hiding ((++))
-import Control.Arrow
-import Control.Monad.Free
-import Control.Comonad.Cofree
-import Data.List hiding (foldl)
-import qualified Data.OrderedMap as Map
-import Rainbow
-
--- | Render a diff with the unified format.
-unified :: Renderer a [Chunk String]
-unified diff (beforeBlob, afterBlob) = fst $ iter g mapped where
-    mapped = fmap (unifiedPatch &&& range) diff
-    toChunk = chunk . toList
-    g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks (source afterBlob) info syntax
-    -- | Render an annotation and syntax into a list of chunks.
-    annotationAndSyntaxToChunks source (Info range _) (Leaf _) = ([ toChunk $ slice range source ], Just range)
-    annotationAndSyntaxToChunks source (Info range _) (Indexed i) = (unifiedRange range i source, Just range)
-    annotationAndSyntaxToChunks source (Info range _) (Fixed f) = (unifiedRange range f source, Just range)
-    annotationAndSyntaxToChunks source (Info range _) (Keyed k) = (unifiedRange range (snd <$> Map.toList k) source, Just range)
-
-    -- | Render a Patch into a list of chunks.
-    unifiedPatch :: Patch (Term a Info) -> [Chunk String]
-    unifiedPatch patch = (fore red . bold <$> beforeChunk) <> (fore green . bold <$> afterChunk) where
-      before = source beforeBlob
-      after = source afterBlob
-      beforeChunk = maybe [] (change "-" . unifiedTerm before) $ Patch.before patch
-      afterChunk = maybe [] (change "+" . unifiedTerm after) $ Patch.after patch
-
-    -- | Render the contents of a Term as a series of chunks.
-    unifiedTerm :: Source Char -> Term a Info -> [Chunk String]
-    unifiedTerm source term = fst $ cata (annotationAndSyntaxToChunks source) term
-
-    -- | Given a range and a list of pairs of chunks and a range, render the
-    -- | entire range from the source as a single list of chunks.
-    unifiedRange :: Range -> [([Chunk String], Maybe Range)] -> Source Char -> [Chunk String]
-    unifiedRange range children source = out <> [ toChunk $ slice Range { start = previous, end = end range } source ]
-      where
-        (out, previous) = foldl' accumulateContext ([], start range) children
-        accumulateContext (out, previous) (child, Just range) = (out <> [ toChunk $ slice Range { start = previous, end = start range } source ] <> child, end range)
-        accumulateContext (out, previous) (child, _) = (out <> child, previous)
-
--- | Return the range of the after side of the patch, or Nothing if it's not a replacement.
-range :: Patch (Term a Info) -> Maybe Range
-range patch = range . extract <$> after patch where
-  extract (annotation :< _) = annotation
-  range (Info range _) = range
-
--- | Add chunks to the beginning and end of the list with curly braces and the given string.
-change :: String -> [Chunk String] -> [Chunk String]
-change bound content = [ chunk "{", chunk bound ] ++ content ++ [ chunk bound, chunk "}" ]

test/CorpusSpec.hs

@@ -4,7 +4,6 @@ import Diffing
 import Renderer
 import qualified Renderer.Patch as P
 import qualified Renderer.Split as Split
-import qualified Renderer.Unified as Unified
 
 import qualified Source as S
 import Control.DeepSeq
@@ -16,7 +15,6 @@ import Data.Maybe
 import Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
-import Rainbow
 import System.FilePath
 import System.FilePath.Glob
 import Test.Hspec
@@ -39,29 +37,26 @@ 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) -> [(String, Renderer a String, FilePath, FilePath, Maybe FilePath)]
-    correctTests paths@(_, _, Nothing, Nothing, Nothing) = testsForPaths paths
+    correctTests paths@(_, _, 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 :: (FilePath, 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 (a, b, patch, split) = [ ("patch", P.patch, a, b, patch), ("split", testSplit, a, b, split) ]
     testSplit :: Renderer a String
     testSplit diff sources = TL.unpack $ Split.split diff sources
-    testUnified :: Renderer a String
-    testUnified diff sources = B1.unpack $ mconcat $ chunksToByteStrings toByteStringsColors0 $ Unified.unified diff sources
 
 
 -- | 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
+-- | have the form "foo.A.js", "foo.B.js", "foo.patch.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)]
 examples directory = do
   as <- toDict <$> globFor "*.A.*"
   bs <- toDict <$> globFor "*.B.*"
   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 patches, Map.lookup name splits)) <$> sort (Set.toList keys)
 
   where
     globFor :: String -> IO [FilePath]

test/diffs-todo/word-diffs.A.js

@@ -1 +0,0 @@
-// some comment here

test/diffs-todo/word-diffs.B.js

@@ -1 +0,0 @@
-// Some comment here

test/diffs-todo/word-diffs.unified.js

@@ -1 +0,0 @@
-// {-some-}{+Some+} comment here;