Merge branch 'master' into document-thy-functions-3

app/Main.hs

@@ -23,6 +23,7 @@ import qualified System.IO as IO
 import qualified Data.Text.ICU.Detect as Detect
 import qualified Data.Text.ICU.Convert as Convert
 import Data.Bifunctor.Join
+import Rainbow
 
 -- | The available types of diff rendering.
 data Format = Unified | Split | Patch
@@ -59,7 +60,11 @@ diff = interpret comparable
 -- | Return a renderer from the command-line arguments that will print the diff.
 printDiff :: Arguments -> Renderer T.Text (IO ())
 printDiff arguments diff sources = case format arguments of
-  Unified -> B1.putStr =<< unified diff sources
+  Unified -> put $ unified diff sources
+    where
+      put chunks = do
+        renderer <- byteStringMakerFromEnvironment
+        B1.putStr $ mconcat $ chunksToByteStrings renderer chunks
   Split -> put (output arguments) =<< split diff sources
     where
       put Nothing rendered = TextIO.putStr rendered

app/Parsers.hs

@@ -22,5 +22,5 @@ lineByLineParser input = return . root . Indexed $ case foldl' annotateLeaves ([
     leaf charIndex line = Info (Range charIndex $ charIndex + T.length line) mempty :< Leaf line
     annotateLeaves (accum, charIndex) line =
       (accum ++ [ leaf charIndex (toText line) ]
-      , charIndex + length line + 1)
+      , charIndex + length line)
     toText = T.pack . Source.toString

semantic-diff.cabal

@@ -67,6 +67,7 @@ executable semantic-diff-exe
                      , filepath
                      , free
                      , optparse-applicative
+                     , rainbow
                      , semantic-diff
                      , text >= 1.2.1.3
                      , text-icu

src/Unified.hs

@@ -14,31 +14,33 @@ import Data.List hiding (foldl)
 import qualified Data.OrderedMap as Map
 import Rainbow
 
-unified :: Renderer a (IO ByteString)
-unified diff (before, after) = do
-  renderer <- byteStringMakerFromEnvironment
-  return . mconcat . chunksToByteStrings renderer . fst $ iter g mapped where
+-- | Render a diff with the unified format.
+unified :: Renderer a [Chunk String]
+unified diff (before, after) = fst $ iter g mapped
+  where
     mapped = fmap (unifiedPatch &&& range) diff
+    toChunk = chunk . toList
     g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks after info syntax
-    annotationAndSyntaxToChunks source (Info range _) (Leaf _) = (pure . chunk . toList $ slice range source, Just range)
+    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 (sort $ snd <$> Map.toList k) source, Just range)
+    annotationAndSyntaxToChunks source (Info range _) (Keyed k) = (unifiedRange range (snd <$> Map.toList k) source, Just range)
 
     unifiedPatch :: Patch (Term a Info) -> [Chunk String]
-    unifiedPatch patch = (fore red . bold <$> beforeChunk) <> (fore green . bold <$> afterChunk) where
-      beforeChunk = maybe [] (change "-" . unifiedTerm before) $ Patch.before patch
-      afterChunk = maybe [] (change "+" . unifiedTerm after) $ Patch.after patch
+    unifiedPatch patch = (fore red . bold <$> beforeChunks) <> (fore green . bold <$> afterChunks)
+      where
+        beforeChunks = maybe [] (change "-" . unifiedTerm before) $ Patch.before patch
+        afterChunks = maybe [] (change "+" . unifiedTerm after) $ Patch.after patch
 
     unifiedTerm :: Source Char -> Term a Info -> [Chunk String]
-
     unifiedTerm source term = fst $ cata (annotationAndSyntaxToChunks source) term
 
     unifiedRange :: Range -> [([Chunk String], Maybe Range)] -> Source Char -> [Chunk String]
-    unifiedRange range children source = out <> (pure . chunk . toList $ slice Range { start = previous, end = end range } source) where
-      (out, previous) = foldl' accumulateContext ([], start range) children
-      accumulateContext (out, previous) (child, Just range) = (mconcat [ out, pure . chunk . toList $ slice Range { start = previous, end = start range } source, child ], end range)
-      accumulateContext (out, previous) (child, _) = (out <> child, previous)
+    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)
 
 range :: Patch (Term a Info) -> Maybe Range
 range patch = range . extract <$> after patch where