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

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

#if !(MIN_VERSION_base(4,11,0))
import Control.Monad.Writer hiding (Any)
#endif
import Data.Functor.Identity
import Data.List (sortOn, foldl')
import qualified Data.Text as T
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Print
import System.Console.CmdArgs.Explicit
import Text.Printf
import Text.Megaparsec
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
  Day
d <- IO Day
getCurrentDay
  let 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 :: [Transaction]
jtxns=(CommandDoc -> [Transaction])
-> ([Transaction] -> [Transaction])
-> Either CommandDoc [Transaction]
-> [Transaction]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CommandDoc -> [Transaction]
forall a. CommandDoc -> a
error' [Transaction] -> [Transaction]
forall a. a -> a
id (Either CommandDoc [Transaction] -> [Transaction])
-> Either CommandDoc [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Day
-> [TransactionModifier]
-> [Transaction]
-> Either CommandDoc [Transaction]
modifyTransactions Day
d [TransactionModifier]
modifiers [Transaction]
ts}  -- PARTIAL:
  -- run the print command, showing all transactions, or show diffs
  RawOpts -> CliOpts -> Journal -> Journal -> IO ()
printOrDiff RawOpts
rawopts CliOpts
opts{reportspec_ :: ReportSpec
reportspec_=ReportSpec
rspec{rsQuery :: Query
rsQuery=Query
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 :: Text -> [TMPostingRule] -> TransactionModifier
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 CustomErr -> TMPostingRule)
-> (TMPostingRule -> TMPostingRule)
-> Either (ParseErrorBundle Text CustomErr) 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 CustomErr -> CommandDoc)
-> ParseErrorBundle Text CustomErr
-> TMPostingRule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text CustomErr -> 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 CustomErr) TMPostingRule
ep  -- PARTIAL:
      where
        ep :: Either (ParseErrorBundle Text CustomErr) TMPostingRule
ep = Identity (Either (ParseErrorBundle Text CustomErr) TMPostingRule)
-> Either (ParseErrorBundle Text CustomErr) TMPostingRule
forall a. Identity a -> a
runIdentity (JournalParser Identity TMPostingRule
-> Text
-> Identity
     (Either (ParseErrorBundle Text CustomErr) TMPostingRule)
forall (m :: * -> *) a.
Monad m =>
JournalParser m a
-> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
runJournalParser (Maybe Year -> JournalParser Identity TMPostingRule
forall (m :: * -> *). Maybe Year -> JournalParser m TMPostingRule
postingp Maybe Year
forall a. Maybe a
Nothing JournalParser Identity TMPostingRule
-> StateT Journal (ParsecT CustomErr Text Identity) ()
-> JournalParser Identity TMPostingRule
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr 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
originalTransaction Transaction
t, Transaction -> Transaction
originalTransaction 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']
    CommandDoc -> IO ()
putStr (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Chunk] -> CommandDoc
renderPatch ([Chunk] -> CommandDoc) -> [Chunk] -> CommandDoc
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 = (GenericSourcePos, [DiffLine String])

-- 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] -> String
renderPatch :: [Chunk] -> CommandDoc
renderPatch = Maybe (CommandDoc, Int) -> [Chunk] -> CommandDoc
forall (t :: * -> *).
Foldable t =>
Maybe (CommandDoc, Int)
-> [(GenericSourcePos, t (DiffLine CommandDoc))] -> CommandDoc
go Maybe (CommandDoc, Int)
forall a. Maybe a
Nothing ([Chunk] -> CommandDoc)
-> ([Chunk] -> [Chunk]) -> [Chunk] -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk -> GenericSourcePos) -> [Chunk] -> [Chunk]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Chunk -> GenericSourcePos
forall a b. (a, b) -> a
fst where
    go :: Maybe (CommandDoc, Int)
-> [(GenericSourcePos, t (DiffLine CommandDoc))] -> CommandDoc
go Maybe (CommandDoc, Int)
_ [] = CommandDoc
""
    go Maybe (CommandDoc, Int)
Nothing cs :: [(GenericSourcePos, t (DiffLine CommandDoc))]
cs@((GenericSourcePos -> CommandDoc
sourceFilePath -> CommandDoc
fp, t (DiffLine CommandDoc)
_):[(GenericSourcePos, t (DiffLine CommandDoc))]
_) = CommandDoc -> CommandDoc
forall t t. (PrintfArg t, PrintfType t) => t -> t
fileHeader CommandDoc
fp CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ Maybe (CommandDoc, Int)
-> [(GenericSourcePos, t (DiffLine CommandDoc))] -> CommandDoc
go ((CommandDoc, Int) -> Maybe (CommandDoc, Int)
forall a. a -> Maybe a
Just (CommandDoc
fp, Int
0)) [(GenericSourcePos, t (DiffLine CommandDoc))]
cs
    go (Just (CommandDoc
fp, Int
_)) cs :: [(GenericSourcePos, t (DiffLine CommandDoc))]
cs@((GenericSourcePos -> CommandDoc
sourceFilePath -> CommandDoc
fp', t (DiffLine CommandDoc)
_):[(GenericSourcePos, t (DiffLine CommandDoc))]
_) | CommandDoc
fp CommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
/= CommandDoc
fp' = Maybe (CommandDoc, Int)
-> [(GenericSourcePos, t (DiffLine CommandDoc))] -> CommandDoc
go Maybe (CommandDoc, Int)
forall a. Maybe a
Nothing [(GenericSourcePos, t (DiffLine CommandDoc))]
cs
    go (Just (CommandDoc
fp, Int
offs)) ((GenericSourcePos -> Int
sourceFirstLine -> Int
lineno, t (DiffLine CommandDoc)
diffs):[(GenericSourcePos, t (DiffLine CommandDoc))]
cs) = CommandDoc
chunkHeader CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
chunk CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ Maybe (CommandDoc, Int)
-> [(GenericSourcePos, t (DiffLine CommandDoc))] -> CommandDoc
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)) [(GenericSourcePos, t (DiffLine CommandDoc))]
cs
        where
            chunkHeader :: CommandDoc
chunkHeader = CommandDoc -> Int -> Int -> Int -> Int -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"@@ -%d,%d +%d,%d @@\n" Int
lineno Int
dels (Int
linenoInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offs) Int
adds where
            (Int
dels, Int
adds) = ((Int, Int) -> DiffLine CommandDoc -> (Int, Int))
-> (Int, Int) -> t (DiffLine CommandDoc) -> (Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int) -> DiffLine CommandDoc -> (Int, Int)
forall a a a. (Num a, Num a) => (a, a) -> DiffLine a -> (a, a)
countDiff (Int
0, Int
0) t (DiffLine CommandDoc)
diffs
            chunk :: CommandDoc
chunk = (DiffLine CommandDoc -> CommandDoc)
-> t (DiffLine CommandDoc) -> CommandDoc
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DiffLine CommandDoc -> CommandDoc
renderLine t (DiffLine CommandDoc)
diffs
    fileHeader :: t -> t
fileHeader t
fp = CommandDoc -> t -> t -> t
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"--- %s\n+++ %s\n" t
fp t
fp

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

    renderLine :: DiffLine CommandDoc -> CommandDoc
renderLine = \case
        Del CommandDoc
s -> Char
'-' Char -> CommandDoc -> CommandDoc
forall a. a -> [a] -> [a]
: CommandDoc
s CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
"\n"
        Add CommandDoc
s -> Char
'+' Char -> CommandDoc -> CommandDoc
forall a. a -> [a] -> [a]
: CommandDoc
s CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
"\n"
        Ctx CommandDoc
s -> Char
' ' Char -> CommandDoc -> CommandDoc
forall a. a -> [a] -> [a]
: CommandDoc
s CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
"\n"

diffTxn :: Journal -> Transaction -> Transaction -> Chunk
diffTxn :: Journal -> Transaction -> Transaction -> Chunk
diffTxn Journal
j Transaction
t Transaction
t' =
        case Transaction -> GenericSourcePos
tsourcepos Transaction
t of
            GenericSourcePos CommandDoc
fp Int
lineno Int
_ -> (CommandDoc -> Int -> Int -> GenericSourcePos
GenericSourcePos CommandDoc
fp (Int
linenoInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
1, [DiffLine CommandDoc]
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 String]
                diffs :: [DiffLine CommandDoc]
diffs = [[DiffLine CommandDoc]] -> [DiffLine CommandDoc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[DiffLine CommandDoc]] -> [DiffLine CommandDoc])
-> ([Diff TMPostingRule] -> [[DiffLine CommandDoc]])
-> [Diff TMPostingRule]
-> [DiffLine CommandDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Diff TMPostingRule -> [DiffLine CommandDoc])
-> [Diff TMPostingRule] -> [[DiffLine CommandDoc]]
forall a b. (a -> b) -> [a] -> [b]
map ((TMPostingRule -> [CommandDoc])
-> DiffLine TMPostingRule -> [DiffLine CommandDoc]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TMPostingRule -> [CommandDoc]
showPostingLines (DiffLine TMPostingRule -> [DiffLine CommandDoc])
-> (Diff TMPostingRule -> DiffLine TMPostingRule)
-> Diff TMPostingRule
-> [DiffLine CommandDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Diff TMPostingRule -> DiffLine TMPostingRule
forall a. Diff a -> DiffLine a
mapDiff) ([Diff TMPostingRule] -> [DiffLine CommandDoc])
-> [Diff TMPostingRule] -> [DiffLine CommandDoc]
forall a b. (a -> b) -> a -> b
$ [TMPostingRule] -> [TMPostingRule] -> [Diff TMPostingRule]
forall a. Eq a => [a] -> [a] -> [Diff a]
D.getDiff (Transaction -> [TMPostingRule]
tpostings Transaction
t) (Transaction -> [TMPostingRule]
tpostings Transaction
t')
            pos :: GenericSourcePos
pos@(JournalSourcePos CommandDoc
fp (Int
line, Int
line')) -> (GenericSourcePos
pos, [DiffLine CommandDoc]
diffs) where
                -- We do diff for original lines vs generated ones. Often leads
                -- to big diff because of re-format effect.
                diffs :: [DiffLine String]
                diffs :: [DiffLine CommandDoc]
diffs = (Diff CommandDoc -> DiffLine CommandDoc)
-> [Diff CommandDoc] -> [DiffLine CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Diff CommandDoc -> DiffLine CommandDoc
forall a. Diff a -> DiffLine a
mapDiff ([Diff CommandDoc] -> [DiffLine CommandDoc])
-> [Diff CommandDoc] -> [DiffLine CommandDoc]
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> [CommandDoc] -> [Diff CommandDoc]
forall a. Eq a => [a] -> [a] -> [Diff a]
D.getDiff [CommandDoc]
source [CommandDoc]
changed'
                source :: [CommandDoc]
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 = (Text -> CommandDoc) -> [Text] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map Text -> CommandDoc
T.unpack ([Text] -> [CommandDoc])
-> ([Text] -> [Text]) -> [Text] -> [CommandDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
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 Int
line' ([Text] -> [CommandDoc]) -> [Text] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
contents
                       | Bool
otherwise = []
                changed :: [CommandDoc]
changed = CommandDoc -> [CommandDoc]
lines (CommandDoc -> [CommandDoc]) -> CommandDoc -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ Transaction -> CommandDoc
showTransaction Transaction
t'
                changed' :: [CommandDoc]
changed' | [CommandDoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CommandDoc]
changed = [CommandDoc]
changed
                         | CommandDoc -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CommandDoc -> Bool) -> CommandDoc -> Bool
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> CommandDoc
forall a. [a] -> a
last [CommandDoc]
changed = [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
changed
                         | Bool
otherwise = [CommandDoc]
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
showList :: [DiffLine a] -> CommandDoc -> CommandDoc
$cshowList :: forall a. Show a => [DiffLine a] -> CommandDoc -> CommandDoc
show :: DiffLine a -> CommandDoc
$cshow :: forall a. Show a => DiffLine a -> CommandDoc
showsPrec :: Int -> DiffLine a -> CommandDoc -> CommandDoc
$cshowsPrec :: forall a. Show a => Int -> DiffLine a -> CommandDoc -> CommandDoc
Show, a -> DiffLine b -> DiffLine a
(a -> b) -> DiffLine a -> DiffLine b
(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
<$ :: a -> DiffLine b -> DiffLine a
$c<$ :: forall a b. a -> DiffLine b -> DiffLine a
fmap :: (a -> b) -> DiffLine a -> DiffLine b
$cfmap :: forall a b. (a -> b) -> DiffLine a -> DiffLine b
Functor, DiffLine a -> Bool
(a -> m) -> DiffLine a -> m
(a -> b -> b) -> b -> DiffLine a -> b
(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
product :: DiffLine a -> a
$cproduct :: forall a. Num a => DiffLine a -> a
sum :: DiffLine a -> a
$csum :: forall a. Num a => DiffLine a -> a
minimum :: DiffLine a -> a
$cminimum :: forall a. Ord a => DiffLine a -> a
maximum :: DiffLine a -> a
$cmaximum :: forall a. Ord a => DiffLine a -> a
elem :: a -> DiffLine a -> Bool
$celem :: forall a. Eq a => a -> DiffLine a -> Bool
length :: DiffLine a -> Int
$clength :: forall a. DiffLine a -> Int
null :: DiffLine a -> Bool
$cnull :: forall a. DiffLine a -> Bool
toList :: DiffLine a -> [a]
$ctoList :: forall a. DiffLine a -> [a]
foldl1 :: (a -> a -> a) -> DiffLine a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> DiffLine a -> a
foldr1 :: (a -> a -> a) -> DiffLine a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> DiffLine a -> a
foldl' :: (b -> a -> b) -> b -> DiffLine a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> DiffLine a -> b
foldl :: (b -> a -> b) -> b -> DiffLine a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> DiffLine a -> b
foldr' :: (a -> b -> b) -> b -> DiffLine a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> DiffLine a -> b
foldr :: (a -> b -> b) -> b -> DiffLine a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> DiffLine a -> b
foldMap' :: (a -> m) -> DiffLine a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> DiffLine a -> m
foldMap :: (a -> m) -> DiffLine a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> DiffLine a -> m
fold :: DiffLine m -> m
$cfold :: forall m. Monoid m => DiffLine m -> m
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
(a -> f b) -> DiffLine a -> f (DiffLine b)
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)
sequence :: DiffLine (m a) -> m (DiffLine a)
$csequence :: forall (m :: * -> *) a. Monad m => DiffLine (m a) -> m (DiffLine a)
mapM :: (a -> m b) -> DiffLine a -> m (DiffLine b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DiffLine a -> m (DiffLine b)
sequenceA :: DiffLine (f a) -> f (DiffLine a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
DiffLine (f a) -> f (DiffLine a)
traverse :: (a -> f b) -> DiffLine a -> f (DiffLine b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DiffLine a -> f (DiffLine b)
$cp2Traversable :: Foldable DiffLine
$cp1Traversable :: Functor DiffLine
Traversable)

mapDiff :: D.Diff a -> DiffLine a
mapDiff :: 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