{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase, OverloadedStrings #-}
module Model
( Step(..)
, MaybeStep(..)
, MatchAlgo(..)
, nextStep
, undo
, context
, suggest
, setCurrentComment
, getCurrentComment
, setTransactionComment
, getTransactionComment
, 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 = 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
""
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)
-> 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
""
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 :: 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
| [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
| 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
| 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
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)
| 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
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
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
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
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
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
suggestNextPosting :: HL.Transaction -> HL.Transaction -> Maybe HL.Posting
suggestNextPosting :: Transaction -> Transaction -> Maybe Posting
suggestNextPosting Transaction
current Transaction
reference =
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)
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
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
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
transactionBalanced :: HL.Transaction -> Bool
transactionBalanced :: Transaction -> Bool
transactionBalanced = BalancingOpts -> Transaction -> Bool
HL.isTransactionBalanced BalancingOpts
HL.defbalancingopts
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
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
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)
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)
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
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
]
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
]
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 ]
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
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))
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
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
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)
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
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
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