build with builder

src/Format.hs

@@ -15,12 +15,13 @@ pprHunkHdr i j = fromString $ "@@ -" ++ show i ++ " +" ++ show j ++ " @@"
 
 lineSep = fromString "\n"
 
-pprHunks :: [Hunk] -> BS
+pprHunks :: [Hunk] -> BB.Builder
-pprHunks = B.concat . map pprHunk
+pprHunks = mconcat . map pprHunk
 
-pprHunk :: Hunk -> BS
+pprHunk :: Hunk -> BB.Builder
-pprHunk ((i, j), toks) = B.concat ((pprHunkHdr i j <> lineSep) : map pprDiff1 toks)
+pprHunk ((i, j), toks) = mconcat ((pprHunkHdr i j <> lineSep) : map pprDiff1 toks)
 
+pprDiff1 :: (Op, Tok) -> BB.Builder
 pprDiff1 (op, (tok, s)) =
   fromString pfx <> escNewlines s <> lineSep
   where
@@ -34,10 +35,9 @@ pprDiff1 (op, (tok, s)) =
       YourChanged -> '>'
     tc = if tok then '|' else '.'
 
-escNewlines = BL.toStrict . BB.toLazyByteString . escNewlines'
+escNewlines :: BS -> BB.Builder
-
+escNewlines s
-escNewlines' s
   | B.null s = mempty
-  | B.head s == BI.c2w '\n' = BB.stringUtf8 "\\n" <> escNewlines' (B.tail s)
+  | B.head s == BI.c2w '\n' = BB.stringUtf8 "\\n" <> escNewlines (B.tail s)
-  | B.head s == BI.c2w '\\' = BB.stringUtf8 "\\\\" <> escNewlines' (B.tail s)
+  | B.head s == BI.c2w '\\' = BB.stringUtf8 "\\\\" <> escNewlines (B.tail s)
-  | otherwise = BB.word8 (B.head s) <> escNewlines' (B.tail s)
+  | otherwise = BB.word8 (B.head s) <> escNewlines (B.tail s)

src/Main.hs

@@ -5,7 +5,6 @@ import qualified Data.ByteString.Builder as BB
 import qualified Data.ByteString.Char8 as B8
 import Data.ByteString.UTF8 (fromString)
 import qualified Data.Vector as V
-import System.IO (stdout)
 import Diff
 import Diff3
 import Format
@@ -13,6 +12,7 @@ import Hunks
 import Merge
 import Options.Applicative
 import Redfa
+import System.IO (stdout)
 import System.IO.MMap
 import Version
 
@@ -46,15 +46,16 @@ data ADiffCommandOpts
       }
   deriving (Show)
 
-diffCmdOptions =
+contextOpt =
-  CmdDiff <$>
   option
     auto
     (metavar "CONTEXT" <>
      short 'C' <>
      long "context" <>
-     value 5 <> help "How many tokens around the change to include in the patch") <*>
+     value 5 <> help "How many tokens around the change to include in the patch")
-  strArgument (metavar "FROMFILE") <*>
+
+diffCmdOptions =
+  CmdDiff <$> contextOpt <*> strArgument (metavar "FROMFILE") <*>
   strArgument (metavar "TOFILE")
 
 patchCmdOptions =
@@ -82,14 +83,7 @@ patchCmdOptions =
   mergeOption True
 
 diff3CmdOptions =
-  CmdDiff3 <$>
+  CmdDiff3 <$> contextOpt <*> strArgument (metavar "MYFILE") <*>
-  option
-    auto
-    (metavar "CONTEXT" <>
-     short 'C' <>
-     long "context" <>
-     value 5 <> help "How many tokens around the change to include in the patch") <*>
-  strArgument (metavar "MYFILE") <*>
   strArgument (metavar "OLDFILE") <*>
   strArgument (metavar "YOURFILE") <*>
   mergeOption False
@@ -106,6 +100,9 @@ actionOption =
 
 adiffOptions = ADiffOptions <$> redfaOption <*> actionOption
 
+loadToks redfa f =
+  mmapFileByteString f Nothing >>= redfaTokenize redfa >>= pure . V.fromList
+
 main :: IO ()
 main =
   let opts :: ParserInfo ADiffOptions
@@ -121,21 +118,16 @@ main =
          redfa <- redfaPrepareRules ropt
          case copt of
            CmdDiff {diffFile1 = f1, diffFile2 = f2, context = ctxt} -> do
-             data1 <- mmapFileByteString f1 Nothing
+             [toks1, toks2] <- traverse (loadToks redfa) [f1, f2]
-             data2 <- mmapFileByteString f2 Nothing
+             BB.hPutBuilder stdout $
-             toks1 <- V.fromList <$> redfaTokenize redfa data1
+               pprHunks $ hunks (max 0 ctxt) $ diffToks toks1 toks2
-             toks2 <- V.fromList <$> redfaTokenize redfa data2
-             B8.putStr $ pprHunks $ hunks (max 0 ctxt) $ diffToks toks1 toks2
            CmdPatch {} -> putStrLn "not supported yet"
            CmdDiff3 ctxt f1 f2 f3 mo -> do
              [toksMine, toksOld, toksYour] <-
-               map V.fromList <$>
+               traverse (loadToks redfa) [f1, f2, f3]
-               traverse
-                 ((>>= redfaTokenize redfa) . flip mmapFileByteString Nothing)
-                 [f1, f2, f3]
              let d3 = diff3Toks toksMine toksOld toksYour
+             BB.hPutBuilder stdout $
                if mergeDoMerge mo
-               then BB.hPutBuilder stdout $ fmtMerged mo d3
+                 then fmtMerged mo d3
-               else B8.putStr $
+                 else pprHunks $
-                    pprHunks $
                       hunks (max 0 ctxt) $ diff3Toks toksMine toksOld toksYour

src/Merge.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+
 module Merge
   ( MergeOpts(..)
   , mergeOption
@@ -25,9 +26,17 @@ data MergeOpts =
 
 marker = fromString . replicate 7
 
-mergeOption forPatch = addLBR <$> ((,) <$> switch (short 'a' <> long "add-linebreak" <> help "Automatically add a line break after conflict markers") <*> mo)
+mergeOption forPatch =
+  addLBR <$>
+  ((,) <$>
+   switch
+     (short 'a' <>
+      long "add-linebreak" <>
+      help "Automatically add a line break after conflict markers") <*>
+   mo)
   where
-   mo = MergeOpts <$>
+    mo =
+      MergeOpts <$>
       switch
         (short 'm' <>
          long "merge" <>
@@ -61,20 +70,24 @@ mergeOption forPatch = addLBR <$> ((,) <$> switch (short 'a' <> long "add-linebr
       strOption
         (long "merge-mine" <>
          value (marker '|') <>
-       help "Marker that separates `mine' from `original' part of the conflict") <*>
+         help
+           "Marker that separates `mine' from `original' part of the conflict") <*>
       strOption
         (long "merge-your" <>
          value (marker '=') <>
-       help "Marker that separates `original' from `your' part of the conflict") <*>
+         help
+           "Marker that separates `original' from `your' part of the conflict") <*>
       strOption
         (long "merge-end" <>
          value (marker '>') <> help "Marker for the end of a conflict")
-   addLBR (False,x)=x
+    addLBR (False, x) = x
-   addLBR (True,x)=x{
+    addLBR (True, x) =
-    mergeCStartStr=mergeCStartStr x <> "\n",
+      x
-    mergeMineSepStr=mergeMineSepStr x <> "\n",
+        { mergeCStartStr = mergeCStartStr x <> "\n"
-    mergeYourSepStr=mergeYourSepStr x <> "\n",
+        , mergeMineSepStr = mergeMineSepStr x <> "\n"
-    mergeCEndStr=mergeCEndStr x <> "\n"}
+        , mergeYourSepStr = mergeYourSepStr x <> "\n"
+        , mergeCEndStr = mergeCEndStr x <> "\n"
+        }
 
 {- This kinda relies on reasonable ordering within the conflicts in the Diff -}
 fmtMerged :: MergeOpts -> Diff -> BB.Builder