diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,11 @@ +# 1.3.0 + + - Detect duplicate transactions and warn about them + - Add empty line before transactions when writing to journal + - Don't elide the last amount in transactions + - Support account directive for account completion + - Bugfixes and dependency bumps + # 1.2.6 - Fix build with hledger-lib >= 1.3.1 diff --git a/hledger-iadd.cabal b/hledger-iadd.cabal --- a/hledger-iadd.cabal +++ b/hledger-iadd.cabal @@ -1,5 +1,5 @@ name: hledger-iadd -version: 1.2.6 +version: 1.3.0 synopsis: A terminal UI as drop-in replacement for hledger add description: This is a terminal UI as drop-in replacement for hledger add. . @@ -57,8 +57,8 @@ , Text.Megaparsec.Compat default-language: Haskell2010 build-depends: base >= 4.8 && < 5 - , hledger-lib >= 1.0 && < 1.4 - , brick >= 0.17 && < 0.25 + , hledger-lib >= 1.0 && < 1.5 + , brick >= 0.17 && < 0.31 , vty >= 5.4 , text , microlens @@ -67,7 +67,7 @@ , transformers >= 0.3 , time >= 1.5 , vector - , megaparsec >= 5.0 && <6.2 + , megaparsec >= 5.0 && <6.4 , containers , optparse-applicative , directory @@ -85,8 +85,8 @@ default-language: Haskell2010 build-depends: base >= 4.8 && < 5 , hledger-iadd - , hledger-lib >= 1.0 && < 1.4 - , brick >= 0.17 && < 0.25 + , hledger-lib >= 1.0 && < 1.5 + , brick >= 0.17 && < 0.31 , vty >= 5.4 , text , microlens @@ -100,7 +100,7 @@ , xdg-basedir , unordered-containers , free >= 4.12.4 - , megaparsec >= 5.0 && <6.2 + , megaparsec >= 5.0 && <6.4 ghc-options: -threaded -Wall -fdefer-typed-holes -fno-warn-name-shadowing test-suite spec @@ -114,7 +114,7 @@ default-language: Haskell2010 build-depends: base >= 4.8 && < 5 , hledger-iadd - , hledger-lib >= 1.0 && < 1.4 + , hledger-lib >= 1.0 && < 1.5 , text , transformers >= 0.3 , time >= 1.5 @@ -123,6 +123,6 @@ , QuickCheck , text-format , free >= 4.12.4 - , megaparsec >= 5.0 && <6.2 + , megaparsec >= 5.0 && <6.4 , text-zipper >= 0.10 ghc-options: -threaded -Wall -fdefer-typed-holes -fno-warn-name-shadowing diff --git a/src/Model.hs b/src/Model.hs --- a/src/Model.hs +++ b/src/Model.hs @@ -16,6 +16,7 @@ -- * Helpers exported for easier testing , accountsByFrequency + , isDuplicateTransaction ) where import Data.Function @@ -33,12 +34,13 @@ import DateParser type Comment = Text +type Duplicate = Bool data Step = DateQuestion Comment | DescriptionQuestion Day Comment | AccountQuestion HL.Transaction Comment | AmountQuestion HL.AccountName HL.Transaction Comment - | FinalQuestion HL.Transaction + | FinalQuestion HL.Transaction Duplicate deriving (Eq, Show) @@ -63,7 +65,7 @@ "" -- empty comment AccountQuestion trans comment | T.null (fromEither entryText) && transactionBalanced trans - -> return $ Right $ Step $ FinalQuestion trans + -> return $ Right $ Step $ FinalQuestion trans (isDuplicateTransaction journal trans) | T.null (fromEither entryText) -- unbalanced -> return $ Left $ "Transaction not balanced! Please balance your transaction before adding it to the journal." | otherwise -> return $ Right $ Step $ @@ -74,7 +76,7 @@ let newPosting = post' name amount comment in AccountQuestion (addPosting newPosting trans) "" - FinalQuestion trans + FinalQuestion trans _ | fromEither entryText == "y" -> return $ Right $ Finished trans | otherwise -> return $ Right $ Step $ AccountQuestion trans "" @@ -89,7 +91,7 @@ [] -> DescriptionQuestion (HL.tdate trans) (HL.tcomment trans) ps -> AmountQuestion (HL.paccount (last ps)) trans { HL.tpostings = init ps } (HL.pcomment (last ps)) AmountQuestion _ trans comment -> Right $ AccountQuestion trans comment - FinalQuestion trans -> undo (AccountQuestion trans "") + FinalQuestion trans _ -> undo (AccountQuestion trans "") context :: HL.Journal -> MatchAlgo -> DateFormat -> Text -> Step -> IO [Text] context _ _ dateFormat entryText (DateQuestion _) = parseDateWithToday dateFormat entryText >>= \case @@ -103,7 +105,7 @@ in filter (matches matchAlgo entryText) names context journal _ _ entryText (AmountQuestion _ _ _) = return $ maybeToList $ T.pack . HL.showMixedAmount <$> trySumAmount journal entryText -context _ _ _ _ (FinalQuestion _) = return [] +context _ _ _ _ (FinalQuestion _ _) = return [] -- | Suggest the initial text of the entry box for each step -- @@ -128,7 +130,7 @@ -> HL.pamount <$> (findPostingByAcc account last) | otherwise -> Just $ negativeAmountSum trans -suggest _ _ (FinalQuestion _) = return $ Just "y" +suggest _ _ (FinalQuestion _ _) = return $ Just "y" getCurrentComment :: Step -> Comment getCurrentComment step = case step of @@ -136,7 +138,7 @@ DescriptionQuestion _ c -> c AccountQuestion _ c -> c AmountQuestion _ _ c -> c - FinalQuestion trans -> HL.tcomment trans + FinalQuestion trans _ -> HL.tcomment trans setCurrentComment :: Comment -> Step -> Step setCurrentComment comment step = case step of @@ -144,7 +146,7 @@ DescriptionQuestion date _ -> DescriptionQuestion date comment AccountQuestion trans _ -> AccountQuestion trans comment AmountQuestion trans name _ -> AmountQuestion trans name comment - FinalQuestion trans -> FinalQuestion trans { HL.tcomment = comment } + FinalQuestion trans duplicate -> FinalQuestion trans { HL.tcomment = comment } duplicate getTransactionComment :: Step -> Comment getTransactionComment step = case step of @@ -152,7 +154,7 @@ DescriptionQuestion _ c -> c AccountQuestion trans _ -> HL.tcomment trans AmountQuestion _ trans _ -> HL.tcomment trans - FinalQuestion trans -> HL.tcomment trans + FinalQuestion trans _ -> HL.tcomment trans setTransactionComment :: Comment -> Step -> Step setTransactionComment comment step = case step of @@ -162,7 +164,7 @@ AccountQuestion (trans { HL.tcomment = comment }) comment' AmountQuestion name trans comment' -> AmountQuestion name (trans { HL.tcomment = comment }) comment' - FinalQuestion trans -> FinalQuestion trans { HL.tcomment = comment } + FinalQuestion trans duplicate -> FinalQuestion trans { HL.tcomment = comment } duplicate -- | Returns true if the pattern is not empty and all of its words occur in the string -- @@ -297,17 +299,92 @@ accountsByFrequency :: HL.Journal -> [HL.AccountName] accountsByFrequency journal = let - accounts = map HL.paccount (HL.journalPostings journal) - frequencyMap :: HM.HashMap HL.AccountName Int = foldr insertOrPlusOne HM.empty accounts + usedAccounts = map HL.paccount (HL.journalPostings journal) + frequencyMap :: HM.HashMap HL.AccountName Int = foldr insertOrPlusOne HM.empty usedAccounts mapWithSubaccounts = foldr insertIfNotPresent frequencyMap (subaccounts frequencyMap) + declaredAccounts = HL.expandAccountNames (HL.jaccounts journal) + mapWithDeclared = foldr insertIfNotPresent mapWithSubaccounts declaredAccounts in - map fst (sortBy (compare `on` (Down . snd)) (HM.toList mapWithSubaccounts)) + map fst (sortBy (compare `on` (Down . snd)) (HM.toList mapWithDeclared)) where insertOrPlusOne = HM.alter (Just . maybe 1 (+1)) insertIfNotPresent account = HM.insertWith (flip const) account 0 subaccounts m = HL.expandAccountNames (HM.keys m) + +-- | Deterimine if a given transaction already occurs in the journal +-- +-- This function ignores certain attributes of transactions, postings and +-- amounts that are either artifacts of knot-tying or are purely for +-- presentation. +-- +-- See the various ...attributes functions in the where clause for details. +isDuplicateTransaction :: HL.Journal -> HL.Transaction -> Bool +isDuplicateTransaction journal trans = any ((==EQ) . cmpTransaction trans) (HL.jtxns journal) + where + -- | Transaction attributes that are compared to determine duplicates + transactionAttributes = + [ cmp HL.tdate, cmp HL.tdate2, cmp HL.tdescription, cmp HL.tstatus + , cmp HL.tcode, cmpPostings `on` HL.tpostings + ] + + -- | Posting attributes that are compared to determine duplicates + postingAttributes = + [ cmp HL.pdate, cmp HL.pdate2, cmp HL.pstatus, cmp HL.paccount + , cmpMixedAmount `on` HL.pamount, cmpPType `on` HL.ptype + , cmp HL.pbalanceassertion + ] + + -- | Ammount attributes that are compared to determine duplicates + amountAttributes = + [ cmp HL.acommodity, cmp HL.aprice, cmp HL.aquantity ] + + -- | Compare two transactions but ignore unimportant details + cmpTransaction :: HL.Transaction -> HL.Transaction -> Ordering + cmpTransaction = lexical transactionAttributes + + + -- | Compare two posting lists of postings by sorting them deterministically + -- and then compare correspondings list elements + cmpPostings :: [HL.Posting] -> [HL.Posting] -> Ordering + cmpPostings ps1 ps2 = + mconcat (zipWith (lexical postingAttributes) (sortPostings ps1) (sortPostings ps2)) + + -- | Compare two posting styles (this should really be an Eq instance) + cmpPType :: HL.PostingType -> HL.PostingType -> Ordering + cmpPType = compare `on` pTypeToInt + where + pTypeToInt :: HL.PostingType -> Int + pTypeToInt HL.RegularPosting = 0 + pTypeToInt HL.VirtualPosting = 1 + pTypeToInt HL.BalancedVirtualPosting = 2 + + -- | Compare two amounts ignoring unimportant details + cmpAmount :: HL.Amount -> HL.Amount -> Ordering + cmpAmount = lexical amountAttributes + + -- | Compare two mixed amounts by first sorting the individual amounts + -- deterministically and then comparing them one-by-one. + cmpMixedAmount :: HL.MixedAmount -> HL.MixedAmount -> Ordering + cmpMixedAmount (HL.Mixed as1) (HL.Mixed as2) = + let + sortedAs1 = sortBy cmpAmount as1 + sortedAs2 = sortBy cmpAmount as2 + in + mconcat $ + compare (length as1) (length as2) : zipWith cmpAmount sortedAs1 sortedAs2 + + sortPostings :: [HL.Posting] -> [HL.Posting] + sortPostings = sortBy (lexical postingAttributes) + + -- | Shortcut for 'compare `on`' + cmp :: Ord b => (a -> b) -> a -> a -> Ordering + cmp f = compare `on` f + + -- | Apply two things with multiple predicats and combine the results lexicographically + lexical :: [a -> b -> Ordering] -> a -> b -> Ordering + lexical fs x y = mconcat (map (\f -> f x y) fs) fromEither :: Either a a -> a fromEither = either id id diff --git a/src/View.hs b/src/View.hs --- a/src/View.hs +++ b/src/View.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE LambdaCase, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module View ( viewState @@ -26,13 +26,13 @@ T.pack (formatTime defaultTimeLocale "%Y/%m/%d" date) <> viewComment comment viewState (AccountQuestion trans comment) = txt $ - T.pack (HL.showTransaction trans) + T.pack (HL.showTransactionUnelided trans) <> viewComment comment viewState (AmountQuestion acc trans comment) = txt $ - T.pack (HL.showTransaction trans) <> " " <> acc + T.pack (HL.showTransactionUnelided trans) <> " " <> acc <> viewComment comment -viewState (FinalQuestion trans) = str $ - HL.showTransaction trans +viewState (FinalQuestion trans _) = str $ + HL.showTransactionUnelided trans viewQuestion :: Step -> Widget n viewQuestion (DateQuestion _) = txt "Date" @@ -41,8 +41,10 @@ "Account " ++ show (numPostings trans + 1) viewQuestion (AmountQuestion _ trans _) = str $ "Amount " ++ show (numPostings trans + 1) -viewQuestion (FinalQuestion _) = txt $ - "Add this transaction to the journal? Y/n" +viewQuestion (FinalQuestion _ duplicate) = txt $ + "Add this transaction to the journal?" + <> (if duplicate then " (warning: duplicate)" else "") -- TODO Add better UI for duplicates + <> " Y/n" viewContext :: (Ord n, Show n) => List n Text -> Widget n viewContext = renderList renderItem True @@ -52,7 +54,7 @@ viewSuggestion (Just t) = txt $ " (" <> t <> ")" renderItem :: Bool -> Text -> Widget n -renderItem True = withAttr listSelectedAttr . txt +renderItem True = withAttr listSelectedAttr . padRight Max . txt renderItem False = txt numPostings :: HL.Transaction -> Int diff --git a/src/main/Main.hs b/src/main/Main.hs --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -291,8 +291,8 @@ -- Furthermore, don't save the input if the FinalQuestion is -- answered by 'n' (for no). , asInputHistory = case (asStep as,s') of - (FinalQuestion _, _) -> asInputHistory as - (_, FinalQuestion _) -> asInputHistory as + (FinalQuestion _ _, _) -> asInputHistory as + (_, FinalQuestion _ _) -> asInputHistory as _ -> inputText : asInputHistory as } @@ -337,7 +337,13 @@ where zipper = gotoEOL (textZipper [content] (Just 1)) addToJournal :: HL.Transaction -> FilePath -> IO () -addToJournal trans path = appendFile path (HL.showTransaction trans) +addToJournal trans path = appendFile path (moveEmptyLine $ HL.showTransactionUnelided trans) + where + -- showTransactionUnelided adds an empty line to the end of the transaction. We want + -- the empty line to be at the start instead, to allow it to be added to a + -- journal that doesn't end with a newline. + moveEmptyLine :: String -> String + moveEmptyLine = unlines . ("":) . init . lines -------------------------------------------------------------------------------- -- Command line and config parsing diff --git a/tests/ModelSpec.hs b/tests/ModelSpec.hs --- a/tests/ModelSpec.hs +++ b/tests/ModelSpec.hs @@ -22,6 +22,7 @@ describe "accountsByFrequency" accByFreqSpec describe "setCurrentComment" setCurrentCommentSpec describe "setTransactionComment" setTransactionCommentSpec + describe "isDuplicateTransaction" isDuplicateTransactionSpec suggestSpec :: Spec @@ -88,7 +89,11 @@ let j = mkJournal [ ((2017, 1, 1), "Foo", [("x:y", 2), ("x:y", 3), ("x:z", 4)]) ] accountsByFrequency j `shouldBe` ["x:y", "x:z", "x"] + it "includes accounts from the 'account directive'" $ do + let j = (mkJournal [ ((2017, 1, 1), "Foo", [("x:y", 2)]) ]) { HL.jaccounts = ["foo:bar"]} + accountsByFrequency j `shouldContain` ["foo:bar", "foo"] + setCurrentCommentSpec :: Spec setCurrentCommentSpec = do it "works at the date prompt" $ @@ -104,7 +109,7 @@ worksOn (AmountQuestion "foo" HL.nulltransaction "") it "works at the final prompt" $ - worksOn (FinalQuestion HL.nulltransaction) + worksOn (FinalQuestion HL.nulltransaction False) where worksOn :: Step -> Expectation @@ -127,7 +132,7 @@ worksOn (AmountQuestion "foo" HL.nulltransaction "") it "works at the final prompt" $ - worksOn (FinalQuestion HL.nulltransaction) + worksOn (FinalQuestion HL.nulltransaction False) where worksOn :: Step -> Expectation @@ -135,6 +140,68 @@ let comment = "a fancy comment" in getTransactionComment (setTransactionComment comment step) `shouldBe` comment +isDuplicateTransactionSpec :: Spec +isDuplicateTransactionSpec = do + it "considers exact copies as duplicates" $ + let trans = ((2017,9,23), "Test", [("Test", 1), ("Toast", -1)]) + in + isDuplicateTransaction (mkJournal [trans]) (mkTransaction trans) + + it "ignores the order of postings" $ + let + t1 = ((2017,9,23), "Test", [("Test", 1), ("Toast", -1)]) + t2 = ((2017,9,23), "Test", [("Toast", -1), ("Test", 1)]) + in + isDuplicateTransaction (mkJournal [t1]) (mkTransaction t2) + + it "ignores comments and tags" $ do + let + t1 = mkTransaction ((2017,9,23), "Test", [("Test", 1), ("Toast", -1)]) + t2 = t1 { HL.tcomment = "Foo" } + t3 = t1 { HL.ttags = [("Foo", "Bar")] } + + isDuplicateTransaction (HL.addTransaction t2 HL.nulljournal) t1 `shouldBe` True + isDuplicateTransaction (HL.addTransaction t3 HL.nulljournal) t1 `shouldBe` True + + it "considers date and description" $ do + let + t1 = ((2017,9,23), "Test", [("Test", 1), ("Toast", -1)]) + t2 = ((2017,9,24), "Test", [("Test", 1), ("Toast", -1)]) + t3 = ((2017,9,23), "Foo", [("Test", 1), ("Toast", -1)]) + + isDuplicateTransaction (mkJournal [t1]) (mkTransaction t2) `shouldBe` False + isDuplicateTransaction (mkJournal [t1]) (mkTransaction t3) `shouldBe` False + + + it "considers date, amount and account of postings" $ do + let + t1 = ((2017,9,23), "Test", [("Test", 1), ("Toast", -1)]) + t2 = ((2017,9,23), "Test", [("Foo", 1), ("Toast", -1)]) + t3 = ((2017,9,23), "Test", [("Test", 2), ("Toast", -1)]) + t4 = ((2017,9,23), "Test", [("Test", 1), ("Toast", -1), ("Foo", 2), ("Bar", -2)]) + + t5p1 = (mkPosting ("Test", 1)) { HL.pdate = Just (fromGregorian 2017 9 23 )} + t5 = (mkTransaction t1) { HL.tpostings = [t5p1, mkPosting ("Toast", -1)]} + + isDuplicateTransaction (mkJournal [t1]) (mkTransaction t2) `shouldBe` False + isDuplicateTransaction (mkJournal [t1]) (mkTransaction t3) `shouldBe` False + isDuplicateTransaction (mkJournal [t1]) (mkTransaction t4) `shouldBe` False + isDuplicateTransaction (mkJournal [t1]) t5 `shouldBe` False + + it "ignores amount presentation" $ do + let a1 = (HL.eur 0.5) { HL.astyle = HL.amountstyle} + a2 = (HL.eur 0.5) { HL.astyle = HL.amountstyle { HL.asprecision = 15} } + + p1 = mkPosting ("Test", -1) + p2 = HL.nullposting { HL.paccount = "Toast", HL.pamount = HL.Mixed [a1] } + p3 = HL.nullposting { HL.paccount = "Toast", HL.pamount = HL.Mixed [a2] } + + t0 = mkTransaction ((2017,9,23), "Test", []) + t1 = t0 { HL.tpostings = [p1,p2,p2] } + t2 = t0 { HL.tpostings = [p1,p3,p3] } + + isDuplicateTransaction (HL.addTransaction t1 HL.nulljournal) t2 `shouldBe` True + -- Helpers type Date = (Integer,Int,Int) -- y, d, m @@ -154,10 +221,9 @@ , HL.tpostings = map mkPosting postings } - where - mkPosting :: (Text, Int) -> HL.Posting - mkPosting (account, amount) = HL.nullposting - { HL.paccount = account - , HL.pamount = HL.mixed [HL.eur (fromIntegral amount)] - } +mkPosting :: (Text, Int) -> HL.Posting +mkPosting (account, amount) = HL.nullposting + { HL.paccount = account + , HL.pamount = HL.mixed [HL.eur (fromIntegral amount)] + }