From 72563ba54c58e58c8dbafd33cfe2a993f214718c Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Sun, 27 Sep 2020 14:57:26 +0200 Subject: [PATCH] build with builder --- src/Format.hs | 20 ++++----- src/Main.hs | 46 +++++++++------------ src/Merge.hs | 111 ++++++++++++++++++++++++++++---------------------- 3 files changed, 91 insertions(+), 86 deletions(-) diff --git a/src/Format.hs b/src/Format.hs index 3bd167b..71cb2a0 100644 --- a/src/Format.hs +++ b/src/Format.hs @@ -15,12 +15,13 @@ pprHunkHdr i j = fromString $ "@@ -" ++ show i ++ " +" ++ show j ++ " @@" lineSep = fromString "\n" -pprHunks :: [Hunk] -> BS -pprHunks = B.concat . map pprHunk +pprHunks :: [Hunk] -> BB.Builder +pprHunks = mconcat . map pprHunk -pprHunk :: Hunk -> BS -pprHunk ((i, j), toks) = B.concat ((pprHunkHdr i j <> lineSep) : map pprDiff1 toks) +pprHunk :: Hunk -> BB.Builder +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' s +escNewlines :: BS -> BB.Builder +escNewlines s | B.null s = mempty - | B.head s == BI.c2w '\n' = BB.stringUtf8 "\\n" <> 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) + | B.head s == BI.c2w '\n' = BB.stringUtf8 "\\n" <> 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) diff --git a/src/Main.hs b/src/Main.hs index e972ed8..8d48b9e 100644 --- a/src/Main.hs +++ b/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 = - CmdDiff <$> +contextOpt = option auto (metavar "CONTEXT" <> short 'C' <> long "context" <> - value 5 <> help "How many tokens around the change to include in the patch") <*> - strArgument (metavar "FROMFILE") <*> + value 5 <> help "How many tokens around the change to include in the patch") + +diffCmdOptions = + CmdDiff <$> contextOpt <*> strArgument (metavar "FROMFILE") <*> strArgument (metavar "TOFILE") patchCmdOptions = @@ -82,14 +83,7 @@ patchCmdOptions = mergeOption True diff3CmdOptions = - CmdDiff3 <$> - 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") <*> + CmdDiff3 <$> contextOpt <*> 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 - data2 <- mmapFileByteString f2 Nothing - toks1 <- V.fromList <$> redfaTokenize redfa data1 - toks2 <- V.fromList <$> redfaTokenize redfa data2 - B8.putStr $ pprHunks $ hunks (max 0 ctxt) $ diffToks toks1 toks2 + [toks1, toks2] <- traverse (loadToks redfa) [f1, f2] + BB.hPutBuilder stdout $ + 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 - ((>>= redfaTokenize redfa) . flip mmapFileByteString Nothing) - [f1, f2, f3] + traverse (loadToks redfa) [f1, f2, f3] let d3 = diff3Toks toksMine toksOld toksYour - if mergeDoMerge mo - then BB.hPutBuilder stdout $ fmtMerged mo d3 - else B8.putStr $ - pprHunks $ - hunks (max 0 ctxt) $ diff3Toks toksMine toksOld toksYour + BB.hPutBuilder stdout $ + if mergeDoMerge mo + then fmtMerged mo d3 + else pprHunks $ + hunks (max 0 ctxt) $ diff3Toks toksMine toksOld toksYour diff --git a/src/Merge.hs b/src/Merge.hs index 7f5b39c..ddd527c 100644 --- a/src/Merge.hs +++ b/src/Merge.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} + module Merge ( MergeOpts(..) , mergeOption @@ -25,56 +26,68 @@ 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 <$> - switch - (short 'm' <> - long "merge" <> - help - (if forPatch - then "Merge using conflict markers instead of printing the rejected hunks" - else "Output the merged file instead of the patch")) <*> - switch - (short 'w' <> - long "whitespace" <> - help - ((if forPatch - then "Force rejecting a thunk" - else "Force a merge conflict") ++ - " on whitespace mismatch")) <*> - switch - (short 'k' <> - long "keep-whitespace" <> - help - ("On whitespace mismatch, default to the version from " ++ - (if forPatch - then "original file" - else "MYFILE") ++ - " instead of the one from " ++ - (if forPatch - then "patch" - else "YOURFILE"))) <*> - strOption - (long "merge-start" <> - value (marker '<') <> help "Marker for the beginning of a conflict") <*> - strOption - (long "merge-mine" <> - value (marker '|') <> - 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") <*> - strOption - (long "merge-end" <> - value (marker '>') <> help "Marker for the end of a conflict") - addLBR (False,x)=x - addLBR (True,x)=x{ - mergeCStartStr=mergeCStartStr x <> "\n", - mergeMineSepStr=mergeMineSepStr x <> "\n", - mergeYourSepStr=mergeYourSepStr x <> "\n", - mergeCEndStr=mergeCEndStr x <> "\n"} + mo = + MergeOpts <$> + switch + (short 'm' <> + long "merge" <> + help + (if forPatch + then "Merge using conflict markers instead of printing the rejected hunks" + else "Output the merged file instead of the patch")) <*> + switch + (short 'w' <> + long "whitespace" <> + help + ((if forPatch + then "Force rejecting a thunk" + else "Force a merge conflict") ++ + " on whitespace mismatch")) <*> + switch + (short 'k' <> + long "keep-whitespace" <> + help + ("On whitespace mismatch, default to the version from " ++ + (if forPatch + then "original file" + else "MYFILE") ++ + " instead of the one from " ++ + (if forPatch + then "patch" + else "YOURFILE"))) <*> + strOption + (long "merge-start" <> + value (marker '<') <> help "Marker for the beginning of a conflict") <*> + strOption + (long "merge-mine" <> + value (marker '|') <> + 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") <*> + strOption + (long "merge-end" <> + value (marker '>') <> help "Marker for the end of a conflict") + addLBR (False, x) = x + addLBR (True, x) = + x + { mergeCStartStr = mergeCStartStr x <> "\n" + , mergeMineSepStr = mergeMineSepStr 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