exa/adiff
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

build with builder

Browse source
This commit is contained in:
Mirek Kratochvil 2020-09-27 14:57:26 +02:00
parent 114a333982
commit 72563ba54c
3 changed files with 91 additions and 86 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/Format.hs
View file

@ -15,12 +15,13 @@ pprHunkHdr i j = fromString $ "@@ -" ++ show i ++ " +" ++ show j ++ " @@"
lineSep = fromString "\n" 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)) = pprDiff1 (op, (tok, s)) =
fromString pfx <> escNewlines s <> lineSep fromString pfx <> escNewlines s <> lineSep
where where
@ -34,10 +35,9 @@ pprDiff1 (op, (tok, s)) =
YourChanged -> '>' YourChanged -> '>'
tc = if tok then '|' else '.' tc = if tok then '|' else '.'
escNewlines = BL.toStrict . BB.toLazyByteString . escNewlines' escNewlines :: BS -> BB.Builder
escNewlines s
escNewlines' s
| B.null s = mempty | 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)

46
src/Main.hs
View file

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

111
src/Merge.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Merge module Merge
( MergeOpts(..) ( MergeOpts(..)
, mergeOption , mergeOption
@ -25,56 +26,68 @@ data MergeOpts =
marker = fromString . replicate 7 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 where
mo = MergeOpts <$> mo =
switch MergeOpts <$>
(short 'm' <> switch
long "merge" <> (short 'm' <>
help long "merge" <>
(if forPatch help
then "Merge using conflict markers instead of printing the rejected hunks" (if forPatch
else "Output the merged file instead of the patch")) <*> then "Merge using conflict markers instead of printing the rejected hunks"
switch else "Output the merged file instead of the patch")) <*>
(short 'w' <> switch
long "whitespace" <> (short 'w' <>
help long "whitespace" <>
((if forPatch help
then "Force rejecting a thunk" ((if forPatch
else "Force a merge conflict") ++ then "Force rejecting a thunk"
" on whitespace mismatch")) <*> else "Force a merge conflict") ++
switch " on whitespace mismatch")) <*>
(short 'k' <> switch
long "keep-whitespace" <> (short 'k' <>
help long "keep-whitespace" <>
("On whitespace mismatch, default to the version from " ++ help
(if forPatch ("On whitespace mismatch, default to the version from " ++
then "original file" (if forPatch
else "MYFILE") ++ then "original file"
" instead of the one from " ++ else "MYFILE") ++
(if forPatch " instead of the one from " ++
then "patch" (if forPatch
else "YOURFILE"))) <*> then "patch"
strOption else "YOURFILE"))) <*>
(long "merge-start" <> strOption
value (marker '<') <> help "Marker for the beginning of a conflict") <*> (long "merge-start" <>
strOption value (marker '<') <> help "Marker for the beginning of a conflict") <*>
(long "merge-mine" <> strOption
value (marker '|') <> (long "merge-mine" <>
help "Marker that separates `mine' from `original' part of the conflict") <*> value (marker '|') <>
strOption help
(long "merge-your" <> "Marker that separates `mine' from `original' part of the conflict") <*>
value (marker '=') <> strOption
help "Marker that separates `original' from `your' part of the conflict") <*> (long "merge-your" <>
strOption value (marker '=') <>
(long "merge-end" <> help
value (marker '>') <> help "Marker for the end of a conflict") "Marker that separates `original' from `your' part of the conflict") <*>
addLBR (False,x)=x strOption
addLBR (True,x)=x{ (long "merge-end" <>
mergeCStartStr=mergeCStartStr x <> "\n", value (marker '>') <> help "Marker for the end of a conflict")
mergeMineSepStr=mergeMineSepStr x <> "\n", addLBR (False, x) = x
mergeYourSepStr=mergeYourSepStr x <> "\n", addLBR (True, x) =
mergeCEndStr=mergeCEndStr x <> "\n"} 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 -} {- This kinda relies on reasonable ordering within the conflicts in the Diff -}
fmtMerged :: MergeOpts -> Diff -> BB.Builder fmtMerged :: MergeOpts -> Diff -> BB.Builder