129 lines
3 KiB
Haskell
129 lines
3 KiB
Haskell
module Format
|
|
( pprHunks
|
|
, pprHunk
|
|
, parsePatch
|
|
) where
|
|
|
|
import Types
|
|
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Data.Attoparsec.ByteString as A
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.ByteString.Builder as BB
|
|
import qualified Data.ByteString.Internal as BI
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import Data.String
|
|
import Data.Word8 as W8
|
|
|
|
backslash :: Word8
|
|
backslash = BI.c2w '\\'
|
|
|
|
newline :: Word8
|
|
newline = BI.c2w '\n'
|
|
|
|
pprHunks :: [Hunk] -> BB.Builder
|
|
pprHunks = mconcat . map pprHunk
|
|
|
|
lineSep :: BB.Builder
|
|
lineSep = BB.word8 newline
|
|
|
|
pprHunkHdr :: Int -> Int -> BB.Builder
|
|
pprHunkHdr i j =
|
|
(fromString $ "@@ -" ++ show i ++ " +" ++ show j ++ " @@") <> lineSep
|
|
|
|
pprHunk :: Hunk -> BB.Builder
|
|
pprHunk ((i, j), toks) = mconcat (pprHunkHdr i j : map pprDiff1 toks)
|
|
|
|
pprDiff1 :: (Op, Tok) -> BB.Builder
|
|
pprDiff1 (op, (tok, s)) = fromString pfx <> escNewlines s <> lineSep
|
|
where
|
|
pfx = [opc, tc]
|
|
opc =
|
|
case op of
|
|
Add -> '+'
|
|
Keep -> ' '
|
|
Remove -> '-'
|
|
MineChanged -> '<'
|
|
Original -> '='
|
|
YourChanged -> '>'
|
|
tc =
|
|
if tok
|
|
then '|'
|
|
else '.'
|
|
|
|
escNewlines :: BS -> BB.Builder
|
|
escNewlines s
|
|
| B.null s = mempty
|
|
| B.head s == newline =
|
|
BB.word8 backslash <> BB.word8 (BI.c2w 'n') <> escNewlines (B.tail s)
|
|
| B.head s == backslash =
|
|
BB.word8 backslash <> BB.word8 backslash <> escNewlines (B.tail s)
|
|
| otherwise = BB.word8 (B.head s) <> escNewlines (B.tail s)
|
|
|
|
--parsePatch :: BS -> Either String [Hunk]
|
|
parsePatch = parseOnly parseHunks
|
|
|
|
parseHunks :: Parser [Hunk]
|
|
parseHunks = many parseHunk <* endOfInput
|
|
|
|
parseHunk :: Parser Hunk
|
|
parseHunk = liftA2 (,) parseHunkHdr (many parseDiff1)
|
|
|
|
parseInt :: Parser Int
|
|
parseInt = read . map BI.w2c <$> some (satisfy W8.isDigit)
|
|
|
|
eol :: Parser ()
|
|
eol = void $ word8 newline
|
|
|
|
parseHunkHdr :: Parser (Int, Int)
|
|
parseHunkHdr = do
|
|
void . string $ fromString "@@ -"
|
|
i <- parseInt
|
|
void . string $ fromString " +"
|
|
j <- parseInt
|
|
void . string $ fromString " @@"
|
|
eol
|
|
return (i, j)
|
|
|
|
pairs2parsers :: [(a, Char)] -> [Parser a]
|
|
pairs2parsers = map (\(x, ch) -> x <$ word8 (BI.c2w ch))
|
|
|
|
parseOpList :: [Parser Op]
|
|
parseOpList =
|
|
pairs2parsers
|
|
[ (Add, '+')
|
|
, (Keep, ' ')
|
|
, (Remove, '-')
|
|
, (MineChanged, '<')
|
|
, (Original, '=')
|
|
, (YourChanged, '>')
|
|
]
|
|
|
|
parseOp :: Parser Op
|
|
parseOp = choice parseOpList
|
|
|
|
parseTokMarkList :: [Parser Bool]
|
|
parseTokMarkList = pairs2parsers [(True, '|'), (False, '.')]
|
|
|
|
parseTokMark :: Parser Bool
|
|
parseTokMark = choice parseTokMarkList
|
|
|
|
parseTokBS :: Parser BS
|
|
parseTokBS =
|
|
(BL.toStrict . BB.toLazyByteString . mconcat <$> many parseTokChar) <* eol
|
|
|
|
parseTokChar :: Parser BB.Builder
|
|
parseTokChar =
|
|
choice
|
|
[ BB.word8 newline <$ string (fromString "\\n")
|
|
, BB.word8 backslash <$ string (fromString "\\\\")
|
|
, BB.word8 <$> satisfy (\w -> w /= backslash && w /= newline)
|
|
]
|
|
|
|
parseTok :: Parser Tok
|
|
parseTok = liftA2 (,) parseTokMark parseTokBS
|
|
|
|
parseDiff1 :: Parser (Op, Tok)
|
|
parseDiff1 = liftA2 (,) parseOp parseTok
|