{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE ViewPatterns      #-}

module Hledger.Cli.Commands.Rewrite (
  rewritemode
 ,rewrite
)
where

import Data.Functor.Identity
import Data.List (sortOn, foldl')
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Print
import System.Console.CmdArgs.Explicit
import Text.Printf
import Text.Megaparsec hiding (pos1)
import qualified Data.Algorithm.Diff as D

rewritemode :: Mode RawOpts
rewritemode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Rewrite.txt")
  [[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq [CommandDoc
"add-posting"] (\CommandDoc
s RawOpts
opts -> RawOpts -> Either CommandDoc RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandDoc RawOpts)
-> RawOpts -> Either CommandDoc RawOpts
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
setopt CommandDoc
"add-posting" CommandDoc
s RawOpts
opts) CommandDoc
"'ACCT  AMTEXPR'"
           CommandDoc
"add a posting to ACCT, which may be parenthesised. AMTEXPR is either a literal amount, or *N which means the transaction's first matched amount multiplied by N (a decimal number). Two spaces separate ACCT and AMTEXPR."
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"diff"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"diff") CommandDoc
"generate diff suitable as an input for patch tool"
  ]
  [(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
  [Flag RawOpts]
hiddenflags
  ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[QUERY] --add-posting \"ACCT  AMTEXPR\" ...")

-- TODO regex matching and interpolating matched name in replacement
-- TODO interpolating match groups in replacement
-- TODO allow using this on unbalanced entries, eg to rewrite while editing

rewrite :: CliOpts -> Journal -> IO ()
rewrite opts :: CliOpts
opts@CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts,reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = do
  -- rewrite matched transactions
  let
    today :: Day
today = ReportSpec -> Day
_rsDay ReportSpec
rspec
    verbosetags :: Bool
verbosetags = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"verbose-tags" RawOpts
rawopts
    modifiers :: [TransactionModifier]
modifiers = CliOpts -> TransactionModifier
transactionModifierFromOpts CliOpts
opts TransactionModifier
-> [TransactionModifier] -> [TransactionModifier]
forall a. a -> [a] -> [a]
: Journal -> [TransactionModifier]
jtxnmodifiers Journal
j
  let j' :: Journal
j' = Journal
j{jtxns=either error' id $ modifyTransactions (journalAccountType j) (journalInheritedAccountTags j) mempty today verbosetags modifiers ts}  -- PARTIAL:
  -- run the print command, showing all transactions, or show diffs
  RawOpts -> CliOpts -> Journal -> Journal -> IO ()
printOrDiff RawOpts
rawopts CliOpts
opts{reportspec_=rspec{_rsQuery=Any}} Journal
j Journal
j'

-- | Build a 'TransactionModifier' from any query arguments and --add-posting flags
-- provided on the command line, or throw a parse error.
transactionModifierFromOpts :: CliOpts -> TransactionModifier
transactionModifierFromOpts :: CliOpts -> TransactionModifier
transactionModifierFromOpts CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts} =
    TransactionModifier{tmquerytxt :: Text
tmquerytxt=Text
q, tmpostingrules :: [TMPostingRule]
tmpostingrules=[TMPostingRule]
ps}
  where
    q :: Text
q = CommandDoc -> Text
T.pack (CommandDoc -> Text)
-> ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommandDoc] -> CommandDoc
unwords ([CommandDoc] -> CommandDoc)
-> ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandDoc -> CommandDoc) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> CommandDoc
quoteIfNeeded ([CommandDoc] -> Text) -> [CommandDoc] -> Text
forall a b. (a -> b) -> a -> b
$ CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt CommandDoc
"args" RawOpts
rawopts
    ps :: [TMPostingRule]
ps = (CommandDoc -> TMPostingRule) -> [CommandDoc] -> [TMPostingRule]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> TMPostingRule
parseposting (Text -> TMPostingRule)
-> (CommandDoc -> Text) -> CommandDoc -> TMPostingRule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc -> Text
T.pack) ([CommandDoc] -> [TMPostingRule])
-> [CommandDoc] -> [TMPostingRule]
forall a b. (a -> b) -> a -> b
$ CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt CommandDoc
"add-posting" RawOpts
rawopts
    parseposting :: Text -> TMPostingRule
parseposting Text
t = (ParseErrorBundle Text HledgerParseErrorData -> TMPostingRule)
-> (TMPostingRule -> TMPostingRule)
-> Either
     (ParseErrorBundle Text HledgerParseErrorData) TMPostingRule
-> TMPostingRule
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CommandDoc -> TMPostingRule
forall a. CommandDoc -> a
error' (CommandDoc -> TMPostingRule)
-> (ParseErrorBundle Text HledgerParseErrorData -> CommandDoc)
-> ParseErrorBundle Text HledgerParseErrorData
-> TMPostingRule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text HledgerParseErrorData -> CommandDoc
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> CommandDoc
errorBundlePretty) TMPostingRule -> TMPostingRule
forall a. a -> a
id Either (ParseErrorBundle Text HledgerParseErrorData) TMPostingRule
ep  -- PARTIAL:
      where
        ep :: Either (ParseErrorBundle Text HledgerParseErrorData) TMPostingRule
ep = Identity
  (Either
     (ParseErrorBundle Text HledgerParseErrorData) TMPostingRule)
-> Either
     (ParseErrorBundle Text HledgerParseErrorData) TMPostingRule
forall a. Identity a -> a
runIdentity (JournalParser Identity TMPostingRule
-> Text
-> Identity
     (Either
        (ParseErrorBundle Text HledgerParseErrorData) TMPostingRule)
forall (m :: * -> *) a.
Monad m =>
JournalParser m a
-> Text
-> m (Either (ParseErrorBundle Text HledgerParseErrorData) a)
runJournalParser (Maybe Year -> JournalParser Identity TMPostingRule
forall (m :: * -> *). Maybe Year -> JournalParser m TMPostingRule
tmpostingrulep Maybe Year
forall a. Maybe a
Nothing JournalParser Identity TMPostingRule
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
-> JournalParser Identity TMPostingRule
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) b
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Text
t')
        t' :: Text
t' = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" -- inject space and newline for proper parsing

printOrDiff :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ())
printOrDiff :: RawOpts -> CliOpts -> Journal -> Journal -> IO ()
printOrDiff RawOpts
opts
    | CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"diff" RawOpts
opts = (Journal -> Journal -> IO ())
-> CliOpts -> Journal -> Journal -> IO ()
forall a b. a -> b -> a
const Journal -> Journal -> IO ()
diffOutput
    | Bool
otherwise = (Journal -> CliOpts -> Journal -> IO ())
-> CliOpts -> Journal -> Journal -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((CliOpts -> Journal -> IO ())
-> Journal -> CliOpts -> Journal -> IO ()
forall a b. a -> b -> a
const CliOpts -> Journal -> IO ()
print')

diffOutput :: Journal -> Journal -> IO ()
diffOutput :: Journal -> Journal -> IO ()
diffOutput Journal
j Journal
j' = do
    let changed :: [(Transaction, Transaction)]
changed = [(Transaction -> Transaction
transactionWithMostlyOriginalPostings Transaction
t, Transaction -> Transaction
transactionWithMostlyOriginalPostings Transaction
t') | (Transaction
t, Transaction
t') <- [Transaction] -> [Transaction] -> [(Transaction, Transaction)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Journal -> [Transaction]
jtxns Journal
j) (Journal -> [Transaction]
jtxns Journal
j'), Transaction
t Transaction -> Transaction -> Bool
forall a. Eq a => a -> a -> Bool
/= Transaction
t']
    Text -> IO ()
T.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Chunk] -> Text
renderPatch ([Chunk] -> Text) -> [Chunk] -> Text
forall a b. (a -> b) -> a -> b
$ ((Transaction, Transaction) -> Chunk)
-> [(Transaction, Transaction)] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map ((Transaction -> Transaction -> Chunk)
-> (Transaction, Transaction) -> Chunk
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Transaction -> Transaction -> Chunk)
 -> (Transaction, Transaction) -> Chunk)
-> (Transaction -> Transaction -> Chunk)
-> (Transaction, Transaction)
-> Chunk
forall a b. (a -> b) -> a -> b
$ Journal -> Transaction -> Transaction -> Chunk
diffTxn Journal
j) [(Transaction, Transaction)]
changed

type Chunk = (SourcePos, [DiffLine Text])

-- XXX doctests, update needed:
-- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.First "x", D.Second "y"])]
-- --- a
-- +++ a
-- @@ -1,1 +1,1 @@
-- -x
-- +y
-- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.Both "x" "x", D.Second "y"]), (GenericSourcePos "a" 5 1, [D.Second "z"])]
-- --- a
-- +++ a
-- @@ -1,1 +1,2 @@
--  x
-- +y
-- @@ -5,0 +6,1 @@
-- +z
-- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.Both "x" "x", D.Second "y"]), (GenericSourcePos "b" 5 1, [D.Second "z"])]
-- --- a
-- +++ a
-- @@ -1,1 +1,2 @@
--  x
-- +y
-- --- b
-- +++ b
-- @@ -5,0 +5,1 @@
-- +z
-- | Render list of changed lines as a unified diff
renderPatch :: [Chunk] -> Text
renderPatch :: [Chunk] -> Text
renderPatch = Maybe (CommandDoc, Int) -> [Chunk] -> Text
forall {t :: * -> *}.
Foldable t =>
Maybe (CommandDoc, Int) -> [(SourcePos, t (DiffLine Text))] -> Text
go Maybe (CommandDoc, Int)
forall a. Maybe a
Nothing ([Chunk] -> Text) -> ([Chunk] -> [Chunk]) -> [Chunk] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk -> SourcePos) -> [Chunk] -> [Chunk]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Chunk -> SourcePos
forall a b. (a, b) -> a
fst where
    go :: Maybe (CommandDoc, Int) -> [(SourcePos, t (DiffLine Text))] -> Text
go Maybe (CommandDoc, Int)
_ [] = Text
""
    go Maybe (CommandDoc, Int)
Nothing cs :: [(SourcePos, t (DiffLine Text))]
cs@((SourcePos CommandDoc
fp Pos
_ Pos
_, t (DiffLine Text)
_):[(SourcePos, t (DiffLine Text))]
_) = CommandDoc -> Text
fileHeader CommandDoc
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe (CommandDoc, Int) -> [(SourcePos, t (DiffLine Text))] -> Text
go ((CommandDoc, Int) -> Maybe (CommandDoc, Int)
forall a. a -> Maybe a
Just (CommandDoc
fp, Int
0)) [(SourcePos, t (DiffLine Text))]
cs
    go (Just (CommandDoc
fp, Int
_)) cs :: [(SourcePos, t (DiffLine Text))]
cs@((SourcePos CommandDoc
fp' Pos
_ Pos
_, t (DiffLine Text)
_):[(SourcePos, t (DiffLine Text))]
_) | CommandDoc
fp CommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
/= CommandDoc
fp' = Maybe (CommandDoc, Int) -> [(SourcePos, t (DiffLine Text))] -> Text
go Maybe (CommandDoc, Int)
forall a. Maybe a
Nothing [(SourcePos, t (DiffLine Text))]
cs
    go (Just (CommandDoc
fp, Int
offs)) ((SourcePos CommandDoc
_ Pos
lineno Pos
_, t (DiffLine Text)
diffs):[(SourcePos, t (DiffLine Text))]
cs) = Text
chunkHeader Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
chnk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe (CommandDoc, Int) -> [(SourcePos, t (DiffLine Text))] -> Text
go ((CommandDoc, Int) -> Maybe (CommandDoc, Int)
forall a. a -> Maybe a
Just (CommandDoc
fp, Int
offs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
adds Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dels)) [(SourcePos, t (DiffLine Text))]
cs
        where
            chunkHeader :: Text
chunkHeader = CommandDoc -> Text
T.pack (CommandDoc -> Text) -> CommandDoc -> Text
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Int -> Int -> Int -> Int -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"@@ -%d,%d +%d,%d @@\n" (Pos -> Int
unPos Pos
lineno) Int
dels (Pos -> Int
unPos Pos
linenoInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offs) Int
adds
            (Int
dels, Int
adds) = ((Int, Int) -> DiffLine Text -> (Int, Int))
-> (Int, Int) -> t (DiffLine Text) -> (Int, Int)
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int) -> DiffLine Text -> (Int, Int)
forall {a} {b} {a}.
(Num a, Num b) =>
(a, b) -> DiffLine a -> (a, b)
countDiff (Int
0, Int
0) t (DiffLine Text)
diffs
            chnk :: Text
chnk = (DiffLine Text -> Text) -> t (DiffLine Text) -> Text
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DiffLine Text -> Text
renderLine t (DiffLine Text)
diffs
    fileHeader :: CommandDoc -> Text
fileHeader CommandDoc
fp = Text
"--- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CommandDoc -> Text
T.pack CommandDoc
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n+++ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CommandDoc -> Text
T.pack CommandDoc
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

    countDiff :: (a, b) -> DiffLine a -> (a, b)
countDiff (a
dels, b
adds) = \case
        Del a
_  -> (a
dels a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
adds)
        Add a
_ -> (a
dels    , b
adds b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
        Ctx a
_ -> (a
dels a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
adds b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)

    renderLine :: DiffLine Text -> Text
renderLine = \case
        Del Text
s -> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Add Text
s -> Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Ctx Text
s -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

diffTxn :: Journal -> Transaction -> Transaction -> Chunk
diffTxn :: Journal -> Transaction -> Transaction -> Chunk
diffTxn Journal
j Transaction
t Transaction
t' = case Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t of
    (pos1 :: SourcePos
pos1@(SourcePos CommandDoc
fp Pos
line Pos
col), SourcePos
pos2) | SourcePos
pos1 SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos
pos2 -> (CommandDoc -> Pos -> Pos -> SourcePos
SourcePos CommandDoc
fp (Pos
line Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Int -> Pos
mkPos Int
1) Pos
col, [DiffLine Text]
diffs) where
        -- TODO: use range and produce two chunks: one removes part of
        --       original file, other adds transaction to new file with
        --       suffix .ledger (generated). I.e. move transaction from one file to another.
        diffs :: [DiffLine Text]
        diffs :: [DiffLine Text]
diffs = (Diff Posting -> [DiffLine Text])
-> [Diff Posting] -> [DiffLine Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Posting -> [Text]) -> DiffLine Posting -> [DiffLine Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DiffLine a -> f (DiffLine b)
traverse Posting -> [Text]
showPostingLines (DiffLine Posting -> [DiffLine Text])
-> (Diff Posting -> DiffLine Posting)
-> Diff Posting
-> [DiffLine Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Diff Posting -> DiffLine Posting
forall a. Diff a -> DiffLine a
mapDiff) ([Diff Posting] -> [DiffLine Text])
-> [Diff Posting] -> [DiffLine Text]
forall a b. (a -> b) -> a -> b
$ [Posting] -> [Posting] -> [Diff Posting]
forall a. Eq a => [a] -> [a] -> [Diff a]
D.getDiff (Transaction -> [Posting]
tpostings Transaction
t) (Transaction -> [Posting]
tpostings Transaction
t')
    (pos1 :: SourcePos
pos1@(SourcePos CommandDoc
fp Pos
line Pos
_), SourcePos CommandDoc
_ Pos
line' Pos
_) -> (SourcePos
pos1, [DiffLine Text]
diffs) where
        -- We do diff for original lines vs generated ones. Often leads
        -- to big diff because of re-format effect.
        diffs :: [DiffLine Text]
        diffs :: [DiffLine Text]
diffs = (Diff Text -> DiffLine Text) -> [Diff Text] -> [DiffLine Text]
forall a b. (a -> b) -> [a] -> [b]
map Diff Text -> DiffLine Text
forall a. Diff a -> DiffLine a
mapDiff ([Diff Text] -> [DiffLine Text]) -> [Diff Text] -> [DiffLine Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> [Diff Text]
forall a. Eq a => [a] -> [a] -> [Diff a]
D.getDiff [Text]
source [Text]
changed'
        source :: [Text]
source | Just Text
contents <- CommandDoc -> [(CommandDoc, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CommandDoc
fp ([(CommandDoc, Text)] -> Maybe Text)
-> [(CommandDoc, Text)] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Journal -> [(CommandDoc, Text)]
jfiles Journal
j = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Pos -> Int
unPos Pos
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Pos -> Int
unPos Pos
line' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
contents
               | Bool
otherwise = []
        changed :: [Text]
changed = Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
t'
        changed' :: [Text]
changed' | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
changed = [Text]
changed
                 | Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
changed = [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
init [Text]
changed
                 | Bool
otherwise = [Text]
changed

data DiffLine a = Del a | Add a | Ctx a
    deriving (Int -> DiffLine a -> CommandDoc -> CommandDoc
[DiffLine a] -> CommandDoc -> CommandDoc
DiffLine a -> CommandDoc
(Int -> DiffLine a -> CommandDoc -> CommandDoc)
-> (DiffLine a -> CommandDoc)
-> ([DiffLine a] -> CommandDoc -> CommandDoc)
-> Show (DiffLine a)
forall a. Show a => Int -> DiffLine a -> CommandDoc -> CommandDoc
forall a. Show a => [DiffLine a] -> CommandDoc -> CommandDoc
forall a. Show a => DiffLine a -> CommandDoc
forall a.
(Int -> a -> CommandDoc -> CommandDoc)
-> (a -> CommandDoc) -> ([a] -> CommandDoc -> CommandDoc) -> Show a
$cshowsPrec :: forall a. Show a => Int -> DiffLine a -> CommandDoc -> CommandDoc
showsPrec :: Int -> DiffLine a -> CommandDoc -> CommandDoc
$cshow :: forall a. Show a => DiffLine a -> CommandDoc
show :: DiffLine a -> CommandDoc
$cshowList :: forall a. Show a => [DiffLine a] -> CommandDoc -> CommandDoc
showList :: [DiffLine a] -> CommandDoc -> CommandDoc
Show, (forall a b. (a -> b) -> DiffLine a -> DiffLine b)
-> (forall a b. a -> DiffLine b -> DiffLine a) -> Functor DiffLine
forall a b. a -> DiffLine b -> DiffLine a
forall a b. (a -> b) -> DiffLine a -> DiffLine b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> DiffLine a -> DiffLine b
fmap :: forall a b. (a -> b) -> DiffLine a -> DiffLine b
$c<$ :: forall a b. a -> DiffLine b -> DiffLine a
<$ :: forall a b. a -> DiffLine b -> DiffLine a
Functor, (forall m. Monoid m => DiffLine m -> m)
-> (forall m a. Monoid m => (a -> m) -> DiffLine a -> m)
-> (forall m a. Monoid m => (a -> m) -> DiffLine a -> m)
-> (forall a b. (a -> b -> b) -> b -> DiffLine a -> b)
-> (forall a b. (a -> b -> b) -> b -> DiffLine a -> b)
-> (forall b a. (b -> a -> b) -> b -> DiffLine a -> b)
-> (forall b a. (b -> a -> b) -> b -> DiffLine a -> b)
-> (forall a. (a -> a -> a) -> DiffLine a -> a)
-> (forall a. (a -> a -> a) -> DiffLine a -> a)
-> (forall a. DiffLine a -> [a])
-> (forall a. DiffLine a -> Bool)
-> (forall a. DiffLine a -> Int)
-> (forall a. Eq a => a -> DiffLine a -> Bool)
-> (forall a. Ord a => DiffLine a -> a)
-> (forall a. Ord a => DiffLine a -> a)
-> (forall a. Num a => DiffLine a -> a)
-> (forall a. Num a => DiffLine a -> a)
-> Foldable DiffLine
forall a. Eq a => a -> DiffLine a -> Bool
forall a. Num a => DiffLine a -> a
forall a. Ord a => DiffLine a -> a
forall m. Monoid m => DiffLine m -> m
forall a. DiffLine a -> Bool
forall a. DiffLine a -> Int
forall a. DiffLine a -> [a]
forall a. (a -> a -> a) -> DiffLine a -> a
forall m a. Monoid m => (a -> m) -> DiffLine a -> m
forall b a. (b -> a -> b) -> b -> DiffLine a -> b
forall a b. (a -> b -> b) -> b -> DiffLine a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => DiffLine m -> m
fold :: forall m. Monoid m => DiffLine m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> DiffLine a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> DiffLine a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> DiffLine a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> DiffLine a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> DiffLine a -> b
foldr :: forall a b. (a -> b -> b) -> b -> DiffLine a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> DiffLine a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> DiffLine a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> DiffLine a -> b
foldl :: forall b a. (b -> a -> b) -> b -> DiffLine a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> DiffLine a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> DiffLine a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> DiffLine a -> a
foldr1 :: forall a. (a -> a -> a) -> DiffLine a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> DiffLine a -> a
foldl1 :: forall a. (a -> a -> a) -> DiffLine a -> a
$ctoList :: forall a. DiffLine a -> [a]
toList :: forall a. DiffLine a -> [a]
$cnull :: forall a. DiffLine a -> Bool
null :: forall a. DiffLine a -> Bool
$clength :: forall a. DiffLine a -> Int
length :: forall a. DiffLine a -> Int
$celem :: forall a. Eq a => a -> DiffLine a -> Bool
elem :: forall a. Eq a => a -> DiffLine a -> Bool
$cmaximum :: forall a. Ord a => DiffLine a -> a
maximum :: forall a. Ord a => DiffLine a -> a
$cminimum :: forall a. Ord a => DiffLine a -> a
minimum :: forall a. Ord a => DiffLine a -> a
$csum :: forall a. Num a => DiffLine a -> a
sum :: forall a. Num a => DiffLine a -> a
$cproduct :: forall a. Num a => DiffLine a -> a
product :: forall a. Num a => DiffLine a -> a
Foldable, Functor DiffLine
Foldable DiffLine
(Functor DiffLine, Foldable DiffLine) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> DiffLine a -> f (DiffLine b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    DiffLine (f a) -> f (DiffLine a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> DiffLine a -> m (DiffLine b))
-> (forall (m :: * -> *) a.
    Monad m =>
    DiffLine (m a) -> m (DiffLine a))
-> Traversable DiffLine
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => DiffLine (m a) -> m (DiffLine a)
forall (f :: * -> *) a.
Applicative f =>
DiffLine (f a) -> f (DiffLine a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DiffLine a -> m (DiffLine b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DiffLine a -> f (DiffLine b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DiffLine a -> f (DiffLine b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DiffLine a -> f (DiffLine b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
DiffLine (f a) -> f (DiffLine a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
DiffLine (f a) -> f (DiffLine a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DiffLine a -> m (DiffLine b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DiffLine a -> m (DiffLine b)
$csequence :: forall (m :: * -> *) a. Monad m => DiffLine (m a) -> m (DiffLine a)
sequence :: forall (m :: * -> *) a. Monad m => DiffLine (m a) -> m (DiffLine a)
Traversable)

mapDiff :: D.Diff a -> DiffLine a
mapDiff :: forall a. Diff a -> DiffLine a
mapDiff = \case
    D.First a
x -> a -> DiffLine a
forall a. a -> DiffLine a
Del a
x
    D.Second a
x -> a -> DiffLine a
forall a. a -> DiffLine a
Add a
x
    D.Both a
x a
_ -> a -> DiffLine a
forall a. a -> DiffLine a
Ctx a
x