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"
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)

42
src/Main.hs
View file

@ -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
BB.hPutBuilder stdout $
if mergeDoMerge mo
then BB.hPutBuilder stdout $ fmtMerged mo d3
else B8.putStr $
pprHunks $
then fmtMerged mo d3
else pprHunks $
hunks (max 0 ctxt) $ diff3Toks toksMine toksOld toksYour

31
src/Merge.hs
View file

@ -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 (True,x)=x{
mergeCStartStr=mergeCStartStr x <> "\n",
mergeMineSepStr=mergeMineSepStr x <> "\n",
mergeYourSepStr=mergeYourSepStr x <> "\n",
mergeCEndStr=mergeCEndStr x <> "\n"}
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