hledger-iadd 1.2.6 → 1.3.0
raw patch · 6 files changed
+200/−41 lines, 6 filesdep ~brickdep ~hledger-libPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: brick, hledger-lib
API changes (from Hackage documentation)
+ Model: isDuplicateTransaction :: Journal -> Transaction -> Bool
- Model: FinalQuestion :: Transaction -> Step
+ Model: FinalQuestion :: Transaction -> Duplicate -> Step
Files
- ChangeLog.md +8/−0
- hledger-iadd.cabal +9/−9
- src/Model.hs +90/−13
- src/View.hs +10/−8
- src/main/Main.hs +9/−3
- tests/ModelSpec.hs +74/−8
ChangeLog.md view
@@ -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
hledger-iadd.cabal view
@@ -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
src/Model.hs view
@@ -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
src/View.hs view
@@ -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
src/main/Main.hs view
@@ -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
tests/ModelSpec.hs view
@@ -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)]+ }