{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase, OverloadedStrings #-}

module Model
       ( Step(..)
       , MaybeStep(..)
       , MatchAlgo(..)
       , nextStep
       , undo
       , context
       , suggest
       , setCurrentComment
       , getCurrentComment
       , setTransactionComment
       , getTransactionComment

       -- * Helpers exported for easier testing
       , accountsByFrequency
       , isDuplicateTransaction
       , isSubsetTransaction
       ) where

import           Data.Function
import           Data.List
import qualified Data.HashMap.Lazy as HM
import           Data.Maybe
import           Data.Monoid
import           Data.Ord (Down(..))
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Time.Ext
import qualified Hledger as HL
import           Data.Foldable
import           Control.Applicative
import           Control.Arrow ((&&&))

import           AmountParser
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 Duplicate
          deriving (Step -> Step -> Bool
(Step -> Step -> Bool) -> (Step -> Step -> Bool) -> Eq Step
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
/= :: Step -> Step -> Bool
Eq, Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
(Int -> Step -> ShowS)
-> (Step -> String) -> ([Step] -> ShowS) -> Show Step
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Step -> ShowS
showsPrec :: Int -> Step -> ShowS
$cshow :: Step -> String
show :: Step -> String
$cshowList :: [Step] -> ShowS
showList :: [Step] -> ShowS
Show)


data MaybeStep = Finished HL.Transaction
               | Step Step
               deriving (MaybeStep -> MaybeStep -> Bool
(MaybeStep -> MaybeStep -> Bool)
-> (MaybeStep -> MaybeStep -> Bool) -> Eq MaybeStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaybeStep -> MaybeStep -> Bool
== :: MaybeStep -> MaybeStep -> Bool
$c/= :: MaybeStep -> MaybeStep -> Bool
/= :: MaybeStep -> MaybeStep -> Bool
Eq, Int -> MaybeStep -> ShowS
[MaybeStep] -> ShowS
MaybeStep -> String
(Int -> MaybeStep -> ShowS)
-> (MaybeStep -> String)
-> ([MaybeStep] -> ShowS)
-> Show MaybeStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaybeStep -> ShowS
showsPrec :: Int -> MaybeStep -> ShowS
$cshow :: MaybeStep -> String
show :: MaybeStep -> String
$cshowList :: [MaybeStep] -> ShowS
showList :: [MaybeStep] -> ShowS
Show)

data MatchAlgo = Fuzzy | Substrings
  deriving (MatchAlgo -> MatchAlgo -> Bool
(MatchAlgo -> MatchAlgo -> Bool)
-> (MatchAlgo -> MatchAlgo -> Bool) -> Eq MatchAlgo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatchAlgo -> MatchAlgo -> Bool
== :: MatchAlgo -> MatchAlgo -> Bool
$c/= :: MatchAlgo -> MatchAlgo -> Bool
/= :: MatchAlgo -> MatchAlgo -> Bool
Eq, Int -> MatchAlgo -> ShowS
[MatchAlgo] -> ShowS
MatchAlgo -> String
(Int -> MatchAlgo -> ShowS)
-> (MatchAlgo -> String)
-> ([MatchAlgo] -> ShowS)
-> Show MatchAlgo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchAlgo -> ShowS
showsPrec :: Int -> MatchAlgo -> ShowS
$cshow :: MatchAlgo -> String
show :: MatchAlgo -> String
$cshowList :: [MatchAlgo] -> ShowS
showList :: [MatchAlgo] -> ShowS
Show)

nextStep :: HL.Journal -> DateFormat -> Either Text Text -> Step -> IO (Either Text MaybeStep)
nextStep :: Journal
-> DateFormat
-> Either Comment Comment
-> Step
-> IO (Either Comment MaybeStep)
nextStep Journal
journal DateFormat
dateFormat Either Comment Comment
entryText Step
current = case Step
current of
  DateQuestion Comment
comment ->
    (Day -> MaybeStep)
-> Either Comment Day -> Either Comment MaybeStep
forall a b. (a -> b) -> Either Comment a -> Either Comment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Step -> MaybeStep
Step (Step -> MaybeStep) -> (Day -> Step) -> Day -> MaybeStep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day -> Comment -> Step) -> Comment -> Day -> Step
forall a b c. (a -> b -> c) -> b -> a -> c
flip Day -> Comment -> Step
DescriptionQuestion Comment
comment)
       (Either Comment Day -> Either Comment MaybeStep)
-> IO (Either Comment Day) -> IO (Either Comment MaybeStep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Comment -> IO (Either Comment Day))
-> (Comment -> IO (Either Comment Day))
-> Either Comment Comment
-> IO (Either Comment Day)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (DateFormat -> Comment -> IO (Either Comment Day)
parseDateWithToday DateFormat
dateFormat) Comment -> IO (Either Comment Day)
parseHLDateWithToday Either Comment Comment
entryText

  DescriptionQuestion Day
day Comment
comment -> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Comment MaybeStep -> IO (Either Comment MaybeStep))
-> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a b. (a -> b) -> a -> b
$ MaybeStep -> Either Comment MaybeStep
forall a b. b -> Either a b
Right (MaybeStep -> Either Comment MaybeStep)
-> MaybeStep -> Either Comment MaybeStep
forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step (Step -> MaybeStep) -> Step -> MaybeStep
forall a b. (a -> b) -> a -> b
$
    Transaction -> Comment -> Step
AccountQuestion Transaction
HL.nulltransaction { HL.tdate = day
                                       , HL.tdescription = fromEither entryText
                                       , HL.tcomment = comment
                                       }
                                       Comment
"" -- empty comment
  AccountQuestion Transaction
trans Comment
comment
    | Comment -> Bool
T.null (Either Comment Comment -> Comment
forall a. Either a a -> a
fromEither Either Comment Comment
entryText) Bool -> Bool -> Bool
&& Transaction -> Bool
transactionBalanced Transaction
trans
      -> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Comment MaybeStep -> IO (Either Comment MaybeStep))
-> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a b. (a -> b) -> a -> b
$ MaybeStep -> Either Comment MaybeStep
forall a b. b -> Either a b
Right (MaybeStep -> Either Comment MaybeStep)
-> MaybeStep -> Either Comment MaybeStep
forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step (Step -> MaybeStep) -> Step -> MaybeStep
forall a b. (a -> b) -> a -> b
$ Transaction -> Bool -> Step
FinalQuestion Transaction
trans (Journal -> Transaction -> Bool
isDuplicateTransaction Journal
journal Transaction
trans)
    | Comment -> Bool
T.null (Either Comment Comment -> Comment
forall a. Either a a -> a
fromEither Either Comment Comment
entryText)  -- unbalanced
      -> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Comment MaybeStep -> IO (Either Comment MaybeStep))
-> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a b. (a -> b) -> a -> b
$ Comment -> Either Comment MaybeStep
forall a b. a -> Either a b
Left Comment
"Transaction not balanced! Please balance your transaction before adding it to the journal."
    | Bool
otherwise        -> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Comment MaybeStep -> IO (Either Comment MaybeStep))
-> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a b. (a -> b) -> a -> b
$ MaybeStep -> Either Comment MaybeStep
forall a b. b -> Either a b
Right (MaybeStep -> Either Comment MaybeStep)
-> MaybeStep -> Either Comment MaybeStep
forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step (Step -> MaybeStep) -> Step -> MaybeStep
forall a b. (a -> b) -> a -> b
$
      Comment -> Transaction -> Comment -> Step
AmountQuestion (Either Comment Comment -> Comment
forall a. Either a a -> a
fromEither Either Comment Comment
entryText) Transaction
trans Comment
comment
  AmountQuestion Comment
name Transaction
trans Comment
comment -> case Journal -> Comment -> Either String MixedAmount
parseAmount Journal
journal (Either Comment Comment -> Comment
forall a. Either a a -> a
fromEither Either Comment Comment
entryText) of
    Left String
err -> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Comment MaybeStep -> IO (Either Comment MaybeStep))
-> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a b. (a -> b) -> a -> b
$ Comment -> Either Comment MaybeStep
forall a b. a -> Either a b
Left (String -> Comment
T.pack String
err)
    Right MixedAmount
amount -> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Comment MaybeStep -> IO (Either Comment MaybeStep))
-> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a b. (a -> b) -> a -> b
$ MaybeStep -> Either Comment MaybeStep
forall a b. b -> Either a b
Right (MaybeStep -> Either Comment MaybeStep)
-> MaybeStep -> Either Comment MaybeStep
forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step (Step -> MaybeStep) -> Step -> MaybeStep
forall a b. (a -> b) -> a -> b
$
      let newPosting :: Posting
newPosting = Comment -> MixedAmount -> Comment -> Posting
post' Comment
name MixedAmount
amount Comment
comment
      in Transaction -> Comment -> Step
AccountQuestion (Posting -> Transaction -> Transaction
addPosting Posting
newPosting Transaction
trans) Comment
""

  FinalQuestion Transaction
trans Bool
_
    | Either Comment Comment -> Comment
forall a. Either a a -> a
fromEither Either Comment Comment
entryText Comment -> [Comment] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Comment
"y", Comment
"Y"] -> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Comment MaybeStep -> IO (Either Comment MaybeStep))
-> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a b. (a -> b) -> a -> b
$ MaybeStep -> Either Comment MaybeStep
forall a b. b -> Either a b
Right (MaybeStep -> Either Comment MaybeStep)
-> MaybeStep -> Either Comment MaybeStep
forall a b. (a -> b) -> a -> b
$ Transaction -> MaybeStep
Finished Transaction
trans
    | Bool
otherwise -> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Comment MaybeStep -> IO (Either Comment MaybeStep))
-> Either Comment MaybeStep -> IO (Either Comment MaybeStep)
forall a b. (a -> b) -> a -> b
$ MaybeStep -> Either Comment MaybeStep
forall a b. b -> Either a b
Right (MaybeStep -> Either Comment MaybeStep)
-> MaybeStep -> Either Comment MaybeStep
forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step (Step -> MaybeStep) -> Step -> MaybeStep
forall a b. (a -> b) -> a -> b
$ Transaction -> Comment -> Step
AccountQuestion Transaction
trans Comment
""

-- | Reverses the last step.
--
-- Returns (Left errorMessage), if the step can't be reversed
undo :: Step -> Either Text Step
undo :: Step -> Either Comment Step
undo Step
current = case Step
current of
  DateQuestion Comment
_ -> Comment -> Either Comment Step
forall a b. a -> Either a b
Left Comment
"Already at oldest step in current transaction"
  DescriptionQuestion Day
_ Comment
comment -> Step -> Either Comment Step
forall a. a -> Either Comment a
forall (m :: * -> *) a. Monad m => a -> m a
return (Comment -> Step
DateQuestion Comment
comment)
  AccountQuestion Transaction
trans Comment
_ -> Step -> Either Comment Step
forall a. a -> Either Comment a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step -> Either Comment Step) -> Step -> Either Comment Step
forall a b. (a -> b) -> a -> b
$ case Transaction -> [Posting]
HL.tpostings Transaction
trans of
    []     -> Day -> Comment -> Step
DescriptionQuestion (Transaction -> Day
HL.tdate Transaction
trans) (Transaction -> Comment
HL.tcomment Transaction
trans)
    [Posting]
ps -> Comment -> Transaction -> Comment -> Step
AmountQuestion (Posting -> Comment
HL.paccount ([Posting] -> Posting
forall a. HasCallStack => [a] -> a
last [Posting]
ps)) Transaction
trans { HL.tpostings = init ps } (Posting -> Comment
HL.pcomment ([Posting] -> Posting
forall a. HasCallStack => [a] -> a
last [Posting]
ps))
  AmountQuestion Comment
_ Transaction
trans Comment
comment -> Step -> Either Comment Step
forall a b. b -> Either a b
Right (Step -> Either Comment Step) -> Step -> Either Comment Step
forall a b. (a -> b) -> a -> b
$ Transaction -> Comment -> Step
AccountQuestion Transaction
trans Comment
comment
  FinalQuestion Transaction
trans Bool
_ -> Step -> Either Comment Step
undo (Transaction -> Comment -> Step
AccountQuestion Transaction
trans Comment
"")

context :: HL.Journal -> MatchAlgo -> DateFormat -> Text -> Step -> IO [Text]
context :: Journal
-> MatchAlgo -> DateFormat -> Comment -> Step -> IO [Comment]
context Journal
_ MatchAlgo
_ DateFormat
dateFormat Comment
entryText (DateQuestion Comment
_) = DateFormat -> Comment -> IO (Either Comment Day)
parseDateWithToday DateFormat
dateFormat Comment
entryText IO (Either Comment Day)
-> (Either Comment Day -> IO [Comment]) -> IO [Comment]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left Comment
_ -> [Comment] -> IO [Comment]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Right Day
date -> [Comment] -> IO [Comment]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Day -> Comment
HL.showDate Day
date]
context Journal
j MatchAlgo
matchAlgo DateFormat
_ Comment
entryText (DescriptionQuestion Day
_ Comment
_) = [Comment] -> IO [Comment]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Comment] -> IO [Comment]) -> [Comment] -> IO [Comment]
forall a b. (a -> b) -> a -> b
$
  let descs :: [Comment]
descs = Journal -> [Comment]
HL.journalDescriptions Journal
j
  in (Comment -> Comment -> Ordering) -> [Comment] -> [Comment]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Journal -> Comment -> Comment -> Ordering
descUses Journal
j) ([Comment] -> [Comment]) -> [Comment] -> [Comment]
forall a b. (a -> b) -> a -> b
$ (Comment -> Bool) -> [Comment] -> [Comment]
forall a. (a -> Bool) -> [a] -> [a]
filter (MatchAlgo -> Comment -> Comment -> Bool
matches MatchAlgo
matchAlgo Comment
entryText) [Comment]
descs
context Journal
j MatchAlgo
matchAlgo DateFormat
_ Comment
entryText (AccountQuestion Transaction
_ Comment
_) = [Comment] -> IO [Comment]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Comment] -> IO [Comment]) -> [Comment] -> IO [Comment]
forall a b. (a -> b) -> a -> b
$
  let names :: [Comment]
names = Journal -> [Comment]
accountsByFrequency Journal
j
  in  (Comment -> Bool) -> [Comment] -> [Comment]
forall a. (a -> Bool) -> [a] -> [a]
filter (MatchAlgo -> Comment -> Comment -> Bool
matches MatchAlgo
matchAlgo Comment
entryText) [Comment]
names
context Journal
journal MatchAlgo
_ DateFormat
_ Comment
entryText (AmountQuestion {}) = [Comment] -> IO [Comment]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Comment] -> IO [Comment]) -> [Comment] -> IO [Comment]
forall a b. (a -> b) -> a -> b
$
  Maybe Comment -> [Comment]
forall a. Maybe a -> [a]
maybeToList (Maybe Comment -> [Comment]) -> Maybe Comment -> [Comment]
forall a b. (a -> b) -> a -> b
$ String -> Comment
T.pack (String -> Comment)
-> (MixedAmount -> String) -> MixedAmount -> Comment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> String
HL.showMixedAmount (MixedAmount -> Comment) -> Maybe MixedAmount -> Maybe Comment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> Comment -> Maybe MixedAmount
trySumAmount Journal
journal Comment
entryText
context Journal
_ MatchAlgo
_ DateFormat
_ Comment
_  (FinalQuestion Transaction
_ Bool
_) = [Comment] -> IO [Comment]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Suggest the initial text of the entry box for each step
--
-- For example, it suggests today for the date prompt
suggest :: HL.Journal -> DateFormat -> Step -> IO (Maybe Text)
suggest :: Journal -> DateFormat -> Step -> IO (Maybe Comment)
suggest Journal
_ DateFormat
dateFormat (DateQuestion Comment
_) =
  Comment -> Maybe Comment
forall a. a -> Maybe a
Just (Comment -> Maybe Comment)
-> (Day -> Comment) -> Day -> Maybe Comment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> Day -> Comment
printDate DateFormat
dateFormat (Day -> Maybe Comment) -> IO Day -> IO (Maybe Comment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Day
getLocalDay
suggest Journal
_ DateFormat
_ (DescriptionQuestion Day
_ Comment
_) = Maybe Comment -> IO (Maybe Comment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Comment
forall a. Maybe a
Nothing
suggest Journal
journal DateFormat
_ (AccountQuestion Transaction
trans Comment
_) = Maybe Comment -> IO (Maybe Comment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Comment -> IO (Maybe Comment))
-> Maybe Comment -> IO (Maybe Comment)
forall a b. (a -> b) -> a -> b
$
  if Transaction -> Int
numPostings Transaction
trans Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& Transaction -> Bool
transactionBalanced Transaction
trans
    then Maybe Comment
forall a. Maybe a
Nothing
    else Posting -> Comment
HL.paccount (Posting -> Comment) -> Maybe Posting -> Maybe Comment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> Transaction -> Maybe Posting
suggestAccountPosting Journal
journal Transaction
trans
suggest Journal
journal DateFormat
_ (AmountQuestion Comment
account Transaction
trans Comment
_) = Maybe Comment -> IO (Maybe Comment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Comment -> IO (Maybe Comment))
-> Maybe Comment -> IO (Maybe Comment)
forall a b. (a -> b) -> a -> b
$ (MixedAmount -> Comment) -> Maybe MixedAmount -> Maybe Comment
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Comment
T.pack (String -> Comment)
-> (MixedAmount -> String) -> MixedAmount -> Comment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> String
HL.showMixedAmount) (Maybe MixedAmount -> Maybe Comment)
-> Maybe MixedAmount -> Maybe Comment
forall a b. (a -> b) -> a -> b
$
  case Journal -> Transaction -> Maybe Transaction
findLastSimilar Journal
journal Transaction
trans of
    Maybe Transaction
Nothing
      -- no similar transaction, first posting => nothing to suggest
      | [Posting] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Transaction -> [Posting]
HL.tpostings Transaction
trans)
        -> Maybe MixedAmount
forall a. Maybe a
Nothing
      -- no similar transaction, so just try to balance the new one
      | Bool
otherwise
        -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just (MixedAmount -> Maybe MixedAmount)
-> MixedAmount -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$ Transaction -> MixedAmount
negativeAmountSum Transaction
trans
    Just Transaction
last
      -- current transaction already balanced => see we have a posting with the
      -- current account in the reference transaction
      | Transaction -> Bool
transactionBalanced Transaction
trans
        -> Posting -> MixedAmount
HL.pamount (Posting -> MixedAmount) -> Maybe Posting -> Maybe MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Comment -> Transaction -> Maybe Posting
findPostingByAcc Comment
account Transaction
last
      -- transaction not balanced, but we're following the reference
      -- transaction. => Try to find a matching posting for the current account.
      -- Otherwise, just balance the current transaction.
      | Transaction
trans Transaction -> Transaction -> Bool
`isSubsetTransaction` Transaction
last
        -> (Posting -> MixedAmount
HL.pamount (Posting -> MixedAmount) -> Maybe Posting -> Maybe MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Comment -> Transaction -> Maybe Posting
findPostingByAcc Comment
account Transaction
last)
           Maybe MixedAmount -> Maybe MixedAmount -> Maybe MixedAmount
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just (Transaction -> MixedAmount
negativeAmountSum Transaction
trans)
      -- we're not balanced and the reference transaction doesn't match anymore
      -- => Just balance the current transaction.
      | Bool
otherwise
        -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just (MixedAmount -> Maybe MixedAmount)
-> MixedAmount -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$ Transaction -> MixedAmount
negativeAmountSum Transaction
trans
suggest Journal
_ DateFormat
_ (FinalQuestion Transaction
_ Bool
_) = Maybe Comment -> IO (Maybe Comment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Comment -> IO (Maybe Comment))
-> Maybe Comment -> IO (Maybe Comment)
forall a b. (a -> b) -> a -> b
$ Comment -> Maybe Comment
forall a. a -> Maybe a
Just Comment
"y"

getCurrentComment :: Step -> Comment
getCurrentComment :: Step -> Comment
getCurrentComment Step
step = case Step
step of
  DateQuestion Comment
c -> Comment
c
  DescriptionQuestion Day
_ Comment
c -> Comment
c
  AccountQuestion Transaction
_ Comment
c -> Comment
c
  AmountQuestion Comment
_ Transaction
_ Comment
c -> Comment
c
  FinalQuestion Transaction
trans Bool
_ -> Transaction -> Comment
HL.tcomment Transaction
trans

setCurrentComment :: Comment -> Step -> Step
setCurrentComment :: Comment -> Step -> Step
setCurrentComment Comment
comment Step
step = case Step
step of
  DateQuestion Comment
_ -> Comment -> Step
DateQuestion Comment
comment
  DescriptionQuestion Day
date Comment
_ -> Day -> Comment -> Step
DescriptionQuestion Day
date Comment
comment
  AccountQuestion Transaction
trans Comment
_ -> Transaction -> Comment -> Step
AccountQuestion Transaction
trans Comment
comment
  AmountQuestion Comment
trans Transaction
name Comment
_ -> Comment -> Transaction -> Comment -> Step
AmountQuestion Comment
trans Transaction
name Comment
comment
  FinalQuestion Transaction
trans Bool
duplicate -> Transaction -> Bool -> Step
FinalQuestion Transaction
trans { HL.tcomment = comment } Bool
duplicate

getTransactionComment :: Step -> Comment
getTransactionComment :: Step -> Comment
getTransactionComment Step
step = case Step
step of
  DateQuestion Comment
c -> Comment
c
  DescriptionQuestion Day
_ Comment
c -> Comment
c
  AccountQuestion Transaction
trans Comment
_ -> Transaction -> Comment
HL.tcomment Transaction
trans
  AmountQuestion Comment
_ Transaction
trans Comment
_ -> Transaction -> Comment
HL.tcomment Transaction
trans
  FinalQuestion Transaction
trans Bool
_ -> Transaction -> Comment
HL.tcomment Transaction
trans

setTransactionComment :: Comment -> Step -> Step
setTransactionComment :: Comment -> Step -> Step
setTransactionComment Comment
comment Step
step = case Step
step of
  DateQuestion Comment
_ -> Comment -> Step
DateQuestion Comment
comment
  DescriptionQuestion Day
date Comment
_ -> Day -> Comment -> Step
DescriptionQuestion Day
date Comment
comment
  AccountQuestion Transaction
trans Comment
comment' ->
    Transaction -> Comment -> Step
AccountQuestion (Transaction
trans { HL.tcomment = comment }) Comment
comment'
  AmountQuestion Comment
name Transaction
trans Comment
comment' ->
    Comment -> Transaction -> Comment -> Step
AmountQuestion Comment
name (Transaction
trans { HL.tcomment = comment }) Comment
comment'
  FinalQuestion Transaction
trans Bool
duplicate -> Transaction -> Bool -> Step
FinalQuestion Transaction
trans { HL.tcomment = comment } Bool
duplicate

-- | Returns true if the pattern is not empty and all of its words occur in the string
--
-- If the pattern is empty, we don't want any entries in the list, so nothing is
-- selected if the users enters an empty string. Empty inputs are special cased,
-- so this is important.
matches :: MatchAlgo -> Text -> Text -> Bool
matches :: MatchAlgo -> Comment -> Comment -> Bool
matches MatchAlgo
algo Comment
a Comment
b
  | Comment -> Bool
T.null Comment
a = Bool
False
  | Bool
otherwise = Comment -> Comment -> Bool
matches' (Comment -> Comment
T.toCaseFold Comment
a) (Comment -> Comment
T.toCaseFold Comment
b)
  where
    matches' :: Comment -> Comment -> Bool
matches' Comment
a' Comment
b'
      | MatchAlgo
algo MatchAlgo -> MatchAlgo -> Bool
forall a. Eq a => a -> a -> Bool
== MatchAlgo
Fuzzy Bool -> Bool -> Bool
&& (Char -> Bool) -> Comment -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Comment
b' = (Comment -> Bool) -> [Comment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Comment -> [Comment] -> Bool
`fuzzyMatch` HasCallStack => Comment -> Comment -> [Comment]
Comment -> Comment -> [Comment]
T.splitOn Comment
":" Comment
b') (Comment -> [Comment]
T.words Comment
a')
      | Bool
otherwise = (Comment -> Bool) -> [Comment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Comment -> Comment -> Bool
`T.isInfixOf` Comment
b') (Comment -> [Comment]
T.words Comment
a')

fuzzyMatch :: Text -> [Text] -> Bool
fuzzyMatch :: Comment -> [Comment] -> Bool
fuzzyMatch Comment
_ [] = Bool
False
fuzzyMatch Comment
query (Comment
part : [Comment]
partsRest) = case Comment -> Maybe (Char, Comment)
T.uncons Comment
query of
  Maybe (Char, Comment)
Nothing -> Bool
True
  Just (Char
c, Comment
queryRest)
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' -> Comment -> [Comment] -> Bool
fuzzyMatch Comment
queryRest [Comment]
partsRest
    | Bool
otherwise -> Comment -> [Comment] -> Bool
fuzzyMatch Comment
query [Comment]
partsRest Bool -> Bool -> Bool
|| case Comment -> Maybe (Char, Comment)
T.uncons Comment
part of
      Maybe (Char, Comment)
Nothing -> Bool
False
      Just (Char
c2, Comment
partRest)
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c2 -> Comment -> [Comment] -> Bool
fuzzyMatch Comment
queryRest (Comment
partRest Comment -> [Comment] -> [Comment]
forall a. a -> [a] -> [a]
: [Comment]
partsRest)
        | Bool
otherwise -> Bool
False

post' :: HL.AccountName -> HL.MixedAmount -> Comment -> HL.Posting
post' :: Comment -> MixedAmount -> Comment -> Posting
post' Comment
account MixedAmount
amount Comment
comment = Posting
HL.nullposting
  { HL.paccount = account
  , HL.pamount = amount
  , HL.pcomment = comment
  }

addPosting :: HL.Posting -> HL.Transaction -> HL.Transaction
addPosting :: Posting -> Transaction -> Transaction
addPosting Posting
p Transaction
t = Transaction
t { HL.tpostings = HL.tpostings t ++ [p] }

trySumAmount :: HL.Journal -> Text -> Maybe HL.MixedAmount
trySumAmount :: Journal -> Comment -> Maybe MixedAmount
trySumAmount Journal
ctx = (String -> Maybe MixedAmount)
-> (MixedAmount -> Maybe MixedAmount)
-> Either String MixedAmount
-> Maybe MixedAmount
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe MixedAmount -> String -> Maybe MixedAmount
forall a b. a -> b -> a
const Maybe MixedAmount
forall a. Maybe a
Nothing) MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just (Either String MixedAmount -> Maybe MixedAmount)
-> (Comment -> Either String MixedAmount)
-> Comment
-> Maybe MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Comment -> Either String MixedAmount
parseAmount Journal
ctx


-- | Given a previous similar transaction, suggest the next posting to enter
--
-- This next posting is the one the user likely wants to type in next.
suggestNextPosting :: HL.Transaction -> HL.Transaction -> Maybe HL.Posting
suggestNextPosting :: Transaction -> Transaction -> Maybe Posting
suggestNextPosting Transaction
current Transaction
reference =
  -- Postings that aren't already used in the new posting
  let unusedPostings :: [Posting]
unusedPostings = (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Posting -> [Posting] -> Bool
forall {t :: * -> *}. Foldable t => Posting -> t Posting -> Bool
`notContainedIn` [Posting]
curPostings) [Posting]
refPostings
  in [Posting] -> Maybe Posting
forall a. [a] -> Maybe a
listToMaybe [Posting]
unusedPostings

  where ([Posting]
refPostings, [Posting]
curPostings) = (Transaction -> [Posting]
HL.tpostings Transaction
reference, Transaction -> [Posting]
HL.tpostings Transaction
current)
        notContainedIn :: Posting -> t Posting -> Bool
notContainedIn Posting
p = Bool -> Bool
not (Bool -> Bool) -> (t Posting -> Bool) -> t Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> Bool) -> t Posting -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Comment -> Comment -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Comment -> Comment -> Bool)
-> (Posting -> Comment) -> Posting -> Posting -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Posting -> Comment
HL.paccount) Posting
p)

-- | Given the last transaction entered, suggest the likely most comparable posting
--
-- Since the transaction isn't necessarily the same type, we can't rely on matching the data
-- so we must use the order. This way if the user typically uses a certain order
-- like expense category and then payment method. Useful if entering many similar postings
-- in a row. For example, when entering transactions from a credit card statement
-- where the first account is usually food, and the second posting is always the credit card.
suggestCorrespondingPosting :: HL.Transaction -> HL.Transaction -> Maybe HL.Posting
suggestCorrespondingPosting :: Transaction -> Transaction -> Maybe Posting
suggestCorrespondingPosting Transaction
current Transaction
reference =
  let postingsEntered :: Int
postingsEntered = [Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
curPostings in
  if Int
postingsEntered Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
refPostings then
    Posting -> Maybe Posting
forall a. a -> Maybe a
Just ([Posting]
refPostings [Posting] -> Int -> Posting
forall a. HasCallStack => [a] -> Int -> a
!! Int
postingsEntered)
  else
    Transaction -> Transaction -> Maybe Posting
suggestNextPosting Transaction
current Transaction
reference
  where ([Posting]
refPostings, [Posting]
curPostings) = (Transaction -> [Posting]
HL.tpostings Transaction
reference, Transaction -> [Posting]
HL.tpostings Transaction
current)

findLastSimilar :: HL.Journal -> HL.Transaction -> Maybe HL.Transaction
findLastSimilar :: Journal -> Transaction -> Maybe Transaction
findLastSimilar Journal
journal Transaction
desc =
  (Transaction -> Transaction -> Ordering)
-> [Transaction] -> Transaction
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Day -> Day -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Day -> Day -> Ordering)
-> (Transaction -> Day) -> Transaction -> Transaction -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Transaction -> Day
HL.tdate) ([Transaction] -> Transaction)
-> Maybe [Transaction] -> Maybe Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Transaction] -> Maybe [Transaction]
forall a. [a] -> Maybe [a]
listToMaybe' ((Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Comment -> Comment -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Comment -> Comment -> Bool)
-> (Transaction -> Comment) -> Transaction -> Transaction -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Transaction -> Comment
HL.tdescription) Transaction
desc) ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
HL.jtxns Journal
journal)

suggestAccountPosting :: HL.Journal -> HL.Transaction -> Maybe HL.Posting
suggestAccountPosting :: Journal -> Transaction -> Maybe Posting
suggestAccountPosting Journal
journal Transaction
trans =
  case Journal -> Transaction -> Maybe Transaction
findLastSimilar Journal
journal Transaction
trans of
    Just Transaction
t -> Transaction -> Transaction -> Maybe Posting
suggestNextPosting Transaction
trans Transaction
t
    Maybe Transaction
Nothing -> [Transaction] -> Maybe [Transaction]
forall a. [a] -> Maybe [a]
listToMaybe' (Journal -> [Transaction]
HL.jtxns Journal
journal) Maybe [Transaction]
-> ([Transaction] -> Maybe Posting) -> Maybe Posting
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Transaction -> Transaction -> Maybe Posting
suggestCorrespondingPosting Transaction
trans (Transaction -> Maybe Posting)
-> ([Transaction] -> Transaction) -> [Transaction] -> Maybe Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> Transaction
forall a. HasCallStack => [a] -> a
last

-- | Return the first Posting that matches the given account name in the transaction
findPostingByAcc :: HL.AccountName -> HL.Transaction -> Maybe HL.Posting
findPostingByAcc :: Comment -> Transaction -> Maybe Posting
findPostingByAcc Comment
account = (Posting -> Bool) -> [Posting] -> Maybe Posting
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Comment -> Comment -> Bool
forall a. Eq a => a -> a -> Bool
==Comment
account) (Comment -> Bool) -> (Posting -> Comment) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Comment
HL.paccount) ([Posting] -> Maybe Posting)
-> (Transaction -> [Posting]) -> Transaction -> Maybe Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
HL.tpostings

-- | Returns True if the first transaction is a subset of the second one.
--
-- That means, all postings from the first transaction are present in the
-- second one.
isSubsetTransaction :: HL.Transaction -> HL.Transaction -> Bool
isSubsetTransaction :: Transaction -> Transaction -> Bool
isSubsetTransaction Transaction
current Transaction
origin =
  let
    origPostings :: [Posting]
origPostings = Transaction -> [Posting]
HL.tpostings Transaction
origin
    currPostings :: [Posting]
currPostings = Transaction -> [Posting]
HL.tpostings Transaction
current
  in
    [Posting] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Posting -> Posting -> Bool) -> [Posting] -> [Posting] -> [Posting]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy Posting -> Posting -> Bool
cmpPosting [Posting]
currPostings [Posting]
origPostings)
  where
    cmpPosting :: Posting -> Posting -> Bool
cmpPosting Posting
a Posting
b =  Posting -> Comment
HL.paccount Posting
a Comment -> Comment -> Bool
forall a. Eq a => a -> a -> Bool
== Posting -> Comment
HL.paccount Posting
b
                   Bool -> Bool -> Bool
&& MixedAmount -> MixedAmount -> Bool
cmpAmount (Posting -> MixedAmount
HL.pamount Posting
a) (Posting -> MixedAmount
HL.pamount Posting
b)

    cmpAmount :: MixedAmount -> MixedAmount -> Bool
cmpAmount MixedAmount
a MixedAmount
b = ([(Comment, Quantity)] -> [(Comment, Quantity)] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([(Comment, Quantity)] -> [(Comment, Quantity)] -> Bool)
-> ([Amount] -> [(Comment, Quantity)])
-> [Amount]
-> [Amount]
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Amount -> (Comment, Quantity))
-> [Amount] -> [(Comment, Quantity)]
forall a b. (a -> b) -> [a] -> [b]
map (Amount -> Comment
HL.acommodity (Amount -> Comment)
-> (Amount -> Quantity) -> Amount -> (Comment, Quantity)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Amount -> Quantity
HL.aquantity)) (MixedAmount -> [Amount]
HL.amounts MixedAmount
a) (MixedAmount -> [Amount]
HL.amounts MixedAmount
b)

listToMaybe' :: [a] -> Maybe [a]
listToMaybe' :: forall a. [a] -> Maybe [a]
listToMaybe' [] = Maybe [a]
forall a. Maybe a
Nothing
listToMaybe' [a]
ls = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
ls

numPostings :: HL.Transaction -> Int
numPostings :: Transaction -> Int
numPostings = [Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Posting] -> Int)
-> (Transaction -> [Posting]) -> Transaction -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
HL.tpostings

-- | Returns True if all postings balance and the transaction is not empty
transactionBalanced :: HL.Transaction -> Bool
transactionBalanced :: Transaction -> Bool
transactionBalanced = BalancingOpts -> Transaction -> Bool
HL.isTransactionBalanced BalancingOpts
HL.defbalancingopts

-- | Computes the sum of all postings in the transaction and inverts it
negativeAmountSum :: HL.Transaction -> HL.MixedAmount
negativeAmountSum :: Transaction -> MixedAmount
negativeAmountSum Transaction
trans =
  let rsum :: MixedAmount
rsum = [Posting] -> MixedAmount
HL.sumPostings ([Posting] -> MixedAmount) -> [Posting] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
HL.realPostings Transaction
trans
  in Quantity -> MixedAmount -> MixedAmount
HL.divideMixedAmount (-Quantity
1) MixedAmount
rsum

-- | Compare two transaction descriptions based on their number of occurences in
-- the given journal.
descUses :: HL.Journal -> Text -> Text -> Ordering
descUses :: Journal -> Comment -> Comment -> Ordering
descUses Journal
journal = Down (Maybe (Sum Int)) -> Down (Maybe (Sum Int)) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Down (Maybe (Sum Int)) -> Down (Maybe (Sum Int)) -> Ordering)
-> (Comment -> Down (Maybe (Sum Int)))
-> Comment
-> Comment
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Maybe (Sum Int) -> Down (Maybe (Sum Int))
forall a. a -> Down a
Down (Maybe (Sum Int) -> Down (Maybe (Sum Int)))
-> (Comment -> Maybe (Sum Int))
-> Comment
-> Down (Maybe (Sum Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comment -> HashMap Comment (Sum Int) -> Maybe (Sum Int))
-> HashMap Comment (Sum Int) -> Comment -> Maybe (Sum Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Comment -> HashMap Comment (Sum Int) -> Maybe (Sum Int)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap Comment (Sum Int)
usesMap
  where usesMap :: HashMap Comment (Sum Int)
usesMap = (Transaction
 -> HashMap Comment (Sum Int) -> HashMap Comment (Sum Int))
-> HashMap Comment (Sum Int)
-> [Transaction]
-> HashMap Comment (Sum Int)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Comment -> HashMap Comment (Sum Int) -> HashMap Comment (Sum Int)
count (Comment -> HashMap Comment (Sum Int) -> HashMap Comment (Sum Int))
-> (Transaction -> Comment)
-> Transaction
-> HashMap Comment (Sum Int)
-> HashMap Comment (Sum Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Comment
HL.tdescription) HashMap Comment (Sum Int)
forall k v. HashMap k v
HM.empty ([Transaction] -> HashMap Comment (Sum Int))
-> [Transaction] -> HashMap Comment (Sum Int)
forall a b. (a -> b) -> a -> b
$
                  Journal -> [Transaction]
HL.jtxns Journal
journal
        -- Add one to the current count of this element
        count :: Text -> HM.HashMap Text (Sum Int) -> HM.HashMap Text (Sum Int)
        count :: Comment -> HashMap Comment (Sum Int) -> HashMap Comment (Sum Int)
count = (Maybe (Sum Int) -> Maybe (Sum Int))
-> Comment
-> HashMap Comment (Sum Int)
-> HashMap Comment (Sum Int)
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (Maybe (Sum Int) -> Maybe (Sum Int) -> Maybe (Sum Int)
forall a. Semigroup a => a -> a -> a
<> Sum Int -> Maybe (Sum Int)
forall a. a -> Maybe a
Just Sum Int
1)

-- | All accounts occuring in the journal sorted in descending order of
-- appearance.
accountsByFrequency :: HL.Journal -> [HL.AccountName]
accountsByFrequency :: Journal -> [Comment]
accountsByFrequency Journal
journal =
  let
    usedAccounts :: [Comment]
usedAccounts = (Posting -> Comment) -> [Posting] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Comment
HL.paccount (Journal -> [Posting]
HL.journalPostings Journal
journal)
    HashMap Comment Int
frequencyMap :: HM.HashMap HL.AccountName Int = (Comment -> HashMap Comment Int -> HashMap Comment Int)
-> HashMap Comment Int -> [Comment] -> HashMap Comment Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Comment -> HashMap Comment Int -> HashMap Comment Int
insertOrPlusOne HashMap Comment Int
forall k v. HashMap k v
HM.empty [Comment]
usedAccounts
    mapWithSubaccounts :: HashMap Comment Int
mapWithSubaccounts = (Comment -> HashMap Comment Int -> HashMap Comment Int)
-> HashMap Comment Int -> [Comment] -> HashMap Comment Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Comment -> HashMap Comment Int -> HashMap Comment Int
forall {k} {v}.
(Hashable k, Num v) =>
k -> HashMap k v -> HashMap k v
insertIfNotPresent HashMap Comment Int
frequencyMap (HashMap Comment Int -> [Comment]
forall {v}. HashMap Comment v -> [Comment]
subaccounts HashMap Comment Int
frequencyMap)
    declaredAccounts :: [Comment]
declaredAccounts = [Comment] -> [Comment]
HL.expandAccountNames (Journal -> [Comment]
HL.journalAccountNamesDeclared Journal
journal)
    mapWithDeclared :: HashMap Comment Int
mapWithDeclared = (Comment -> HashMap Comment Int -> HashMap Comment Int)
-> HashMap Comment Int -> [Comment] -> HashMap Comment Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Comment -> HashMap Comment Int -> HashMap Comment Int
forall {k} {v}.
(Hashable k, Num v) =>
k -> HashMap k v -> HashMap k v
insertIfNotPresent HashMap Comment Int
mapWithSubaccounts [Comment]
declaredAccounts
  in
    ((Comment, Int) -> Comment) -> [(Comment, Int)] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map (Comment, Int) -> Comment
forall a b. (a, b) -> a
fst (((Comment, Int) -> (Comment, Int) -> Ordering)
-> [(Comment, Int)] -> [(Comment, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Down Int -> Down Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Down Int -> Down Int -> Ordering)
-> ((Comment, Int) -> Down Int)
-> (Comment, Int)
-> (Comment, Int)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int)
-> ((Comment, Int) -> Int) -> (Comment, Int) -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comment, Int) -> Int
forall a b. (a, b) -> b
snd) (HashMap Comment Int -> [(Comment, Int)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Comment Int
mapWithDeclared))


  where
    insertOrPlusOne :: Comment -> HashMap Comment Int -> HashMap Comment Int
insertOrPlusOne = (Maybe Int -> Maybe Int)
-> Comment -> HashMap Comment Int -> HashMap Comment Int
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Maybe Int -> Int) -> Maybe Int -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
    insertIfNotPresent :: k -> HashMap k v -> HashMap k v
insertIfNotPresent k
account = (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith (\ v
_ v
x -> v
x) k
account v
0
    subaccounts :: HashMap Comment v -> [Comment]
subaccounts HashMap Comment v
m = [Comment] -> [Comment]
HL.expandAccountNames (HashMap Comment v -> [Comment]
forall k v. HashMap k v -> [k]
HM.keys HashMap Comment v
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 -> Transaction -> Bool
isDuplicateTransaction  Journal
journal Transaction
trans = (Transaction -> Bool) -> [Transaction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==Ordering
EQ) (Ordering -> Bool)
-> (Transaction -> Ordering) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Transaction -> Ordering
cmpTransaction Transaction
trans) (Journal -> [Transaction]
HL.jtxns Journal
journal)
  where
    -- | Transaction attributes that are compared to determine duplicates
    transactionAttributes :: [Transaction -> Transaction -> Ordering]
transactionAttributes =
      [ (Transaction -> Day) -> Transaction -> Transaction -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Day
HL.tdate, (Transaction -> Maybe Day)
-> Transaction -> Transaction -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Maybe Day
HL.tdate2, (Transaction -> Comment) -> Transaction -> Transaction -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Comment
HL.tdescription, (Transaction -> Status) -> Transaction -> Transaction -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Status
HL.tstatus
      , (Transaction -> Comment) -> Transaction -> Transaction -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Comment
HL.tcode, [Posting] -> [Posting] -> Ordering
cmpPostings ([Posting] -> [Posting] -> Ordering)
-> (Transaction -> [Posting])
-> Transaction
-> Transaction
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Transaction -> [Posting]
HL.tpostings
      ]

    -- | Posting attributes that are compared to determine duplicates
    postingAttributes :: [Posting -> Posting -> Ordering]
postingAttributes =
      [ (Posting -> Maybe Day) -> Posting -> Posting -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Posting -> Maybe Day
HL.pdate, (Posting -> Maybe Day) -> Posting -> Posting -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Posting -> Maybe Day
HL.pdate2, (Posting -> Status) -> Posting -> Posting -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Posting -> Status
HL.pstatus, (Posting -> Comment) -> Posting -> Posting -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Posting -> Comment
HL.paccount
      , MixedAmount -> MixedAmount -> Ordering
cmpMixedAmount (MixedAmount -> MixedAmount -> Ordering)
-> (Posting -> MixedAmount) -> Posting -> Posting -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Posting -> MixedAmount
HL.pamount, PostingType -> PostingType -> Ordering
cmpPType (PostingType -> PostingType -> Ordering)
-> (Posting -> PostingType) -> Posting -> Posting -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Posting -> PostingType
HL.ptype
      , (Maybe Ordering -> Ordering)
-> (Maybe BalanceAssertion -> Maybe Ordering)
-> Maybe BalanceAssertion
-> Ordering
forall a b.
(a -> b)
-> (Maybe BalanceAssertion -> a) -> Maybe BalanceAssertion -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Ordering -> Ordering
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ((Maybe BalanceAssertion -> Maybe Ordering)
 -> Maybe BalanceAssertion -> Ordering)
-> (Maybe BalanceAssertion
    -> Maybe BalanceAssertion -> Maybe Ordering)
-> Maybe BalanceAssertion
-> Maybe BalanceAssertion
-> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BalanceAssertion -> BalanceAssertion -> Ordering)
-> Maybe BalanceAssertion
-> Maybe BalanceAssertion
-> Maybe Ordering
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 BalanceAssertion -> BalanceAssertion -> Ordering
cmpBalanceAssertion (Maybe BalanceAssertion -> Maybe BalanceAssertion -> Ordering)
-> (Posting -> Maybe BalanceAssertion)
-> Posting
-> Posting
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Posting -> Maybe BalanceAssertion
HL.pbalanceassertion
      ]

    -- | Ammount attributes that are compared to determine duplicates
    amountAttributes :: [Amount -> Amount -> Ordering]
amountAttributes =
      [ (Amount -> Comment) -> Amount -> Amount -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Amount -> Comment
HL.acommodity, (Amount -> Maybe AmountPrice) -> Amount -> Amount -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Amount -> Maybe AmountPrice
HL.aprice, (Amount -> Quantity) -> Amount -> Amount -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Amount -> Quantity
HL.aquantity ]

    -- | Compare two transactions but ignore unimportant details
    cmpTransaction :: HL.Transaction -> HL.Transaction -> Ordering
    cmpTransaction :: Transaction -> Transaction -> Ordering
cmpTransaction = [Transaction -> Transaction -> Ordering]
-> Transaction -> Transaction -> Ordering
forall a b. [a -> b -> Ordering] -> a -> b -> Ordering
lexical [Transaction -> Transaction -> Ordering]
transactionAttributes


    -- | Compare two posting lists of postings by sorting them deterministically
    -- and then compare correspondings list elements
    cmpPostings :: [HL.Posting] -> [HL.Posting] -> Ordering
    cmpPostings :: [Posting] -> [Posting] -> Ordering
cmpPostings [Posting]
ps1 [Posting]
ps2 =
      [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat ((Posting -> Posting -> Ordering)
-> [Posting] -> [Posting] -> [Ordering]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([Posting -> Posting -> Ordering] -> Posting -> Posting -> Ordering
forall a b. [a -> b -> Ordering] -> a -> b -> Ordering
lexical [Posting -> Posting -> Ordering]
postingAttributes) ([Posting] -> [Posting]
sortPostings [Posting]
ps1) ([Posting] -> [Posting]
sortPostings [Posting]
ps2))

    -- | Compare two posting styles (this should really be an Eq instance)
    cmpPType :: HL.PostingType -> HL.PostingType -> Ordering
    cmpPType :: PostingType -> PostingType -> Ordering
cmpPType = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (PostingType -> Int) -> PostingType -> PostingType -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PostingType -> Int
pTypeToInt
      where
        pTypeToInt :: HL.PostingType -> Int
        pTypeToInt :: PostingType -> Int
pTypeToInt PostingType
HL.RegularPosting = Int
0
        pTypeToInt PostingType
HL.VirtualPosting = Int
1
        pTypeToInt PostingType
HL.BalancedVirtualPosting = Int
2

    -- | Compare two amounts ignoring unimportant details
    cmpAmount :: HL.Amount -> HL.Amount -> Ordering
    cmpAmount :: Amount -> Amount -> Ordering
cmpAmount = [Amount -> Amount -> Ordering] -> Amount -> Amount -> Ordering
forall a b. [a -> b -> Ordering] -> a -> b -> Ordering
lexical [Amount -> Amount -> Ordering]
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 :: MixedAmount -> MixedAmount -> Ordering
cmpMixedAmount MixedAmount
as1 MixedAmount
as2 =
      let
        sortedAs1 :: [Amount]
sortedAs1 = (Amount -> Amount -> Ordering) -> [Amount] -> [Amount]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Amount -> Amount -> Ordering
cmpAmount ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
HL.amounts MixedAmount
as1
        sortedAs2 :: [Amount]
sortedAs2 = (Amount -> Amount -> Ordering) -> [Amount] -> [Amount]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Amount -> Amount -> Ordering
cmpAmount ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
HL.amounts MixedAmount
as2
      in
        [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat ([Ordering] -> Ordering) -> [Ordering] -> Ordering
forall a b. (a -> b) -> a -> b
$
          Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Amount] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Amount] -> Int) -> [Amount] -> Int
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
HL.amounts MixedAmount
as1) ([Amount] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Amount] -> Int) -> [Amount] -> Int
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
HL.amounts MixedAmount
as2) Ordering -> [Ordering] -> [Ordering]
forall a. a -> [a] -> [a]
: (Amount -> Amount -> Ordering)
-> [Amount] -> [Amount] -> [Ordering]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Amount -> Amount -> Ordering
cmpAmount [Amount]
sortedAs1 [Amount]
sortedAs2

    cmpBalanceAssertion :: HL.BalanceAssertion -> HL.BalanceAssertion -> Ordering
    cmpBalanceAssertion :: BalanceAssertion -> BalanceAssertion -> Ordering
cmpBalanceAssertion = [BalanceAssertion -> BalanceAssertion -> Ordering]
-> BalanceAssertion -> BalanceAssertion -> Ordering
forall a b. [a -> b -> Ordering] -> a -> b -> Ordering
lexical [(BalanceAssertion -> Amount)
-> BalanceAssertion -> BalanceAssertion -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp BalanceAssertion -> Amount
HL.baamount, (BalanceAssertion -> Bool)
-> BalanceAssertion -> BalanceAssertion -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp BalanceAssertion -> Bool
HL.batotal]

    sortPostings :: [HL.Posting] -> [HL.Posting]
    sortPostings :: [Posting] -> [Posting]
sortPostings = (Posting -> Posting -> Ordering) -> [Posting] -> [Posting]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ([Posting -> Posting -> Ordering] -> Posting -> Posting -> Ordering
forall a b. [a -> b -> Ordering] -> a -> b -> Ordering
lexical [Posting -> Posting -> Ordering]
postingAttributes)

    -- | Shortcut for 'compare `on`'
    cmp :: Ord b => (a -> b) -> a -> a -> Ordering
    cmp :: forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp a -> b
f = b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering) -> (a -> b) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f

    -- | Apply two things with multiple predicats and combine the results lexicographically
    lexical :: [a -> b -> Ordering] -> a -> b -> Ordering
    lexical :: forall a b. [a -> b -> Ordering] -> a -> b -> Ordering
lexical = [a -> b -> Ordering] -> a -> b -> Ordering
forall a. Monoid a => [a] -> a
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold -- hehe

fromEither :: Either a a -> a
fromEither :: forall a. Either a a -> a
fromEither = (a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id