build with builder
This commit is contained in:
parent
114a333982
commit
72563ba54c
|
|
@ -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)
|
||||
|
|
|
|||
46
src/Main.hs
46
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
|
||||
|
|
|
|||
111
src/Merge.hs
111
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue