{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c== :: Step -> Step -> Bool
Eq, Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Step] -> ShowS
$cshowList :: [Step] -> ShowS
show :: Step -> String
$cshow :: Step -> String
showsPrec :: Int -> Step -> ShowS
$cshowsPrec :: Int -> Step -> ShowS
Show)
data MaybeStep = Finished HL.Transaction
| Step Step
deriving (MaybeStep -> MaybeStep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaybeStep -> MaybeStep -> Bool
$c/= :: MaybeStep -> MaybeStep -> Bool
== :: MaybeStep -> MaybeStep -> Bool
$c== :: MaybeStep -> MaybeStep -> Bool
Eq, Int -> MaybeStep -> ShowS
[MaybeStep] -> ShowS
MaybeStep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaybeStep] -> ShowS
$cshowList :: [MaybeStep] -> ShowS
show :: MaybeStep -> String
$cshow :: MaybeStep -> String
showsPrec :: Int -> MaybeStep -> ShowS
$cshowsPrec :: Int -> MaybeStep -> ShowS
Show)
data MatchAlgo = Fuzzy | Substrings
deriving (MatchAlgo -> MatchAlgo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchAlgo -> MatchAlgo -> Bool
$c/= :: MatchAlgo -> MatchAlgo -> Bool
== :: MatchAlgo -> MatchAlgo -> Bool
$c== :: MatchAlgo -> MatchAlgo -> Bool
Eq, Int -> MatchAlgo -> ShowS
[MatchAlgo] -> ShowS
MatchAlgo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchAlgo] -> ShowS
$cshowList :: [MatchAlgo] -> ShowS
show :: MatchAlgo -> String
$cshow :: MatchAlgo -> String
showsPrec :: Int -> MatchAlgo -> ShowS
$cshowsPrec :: Int -> 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 ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Step -> MaybeStep
Step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Day -> Comment -> Step
DescriptionQuestion Comment
comment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step forall a b. (a -> b) -> a -> b
$
Transaction -> Comment -> Step
AccountQuestion Transaction
HL.nulltransaction { tdate :: Day
HL.tdate = Day
day
, tdescription :: Comment
HL.tdescription = forall a. Either a a -> a
fromEither Either Comment Comment
entryText
, tcomment :: Comment
HL.tcomment = Comment
comment
}
Comment
""
AccountQuestion Transaction
trans Comment
comment
| Comment -> Bool
T.null (forall a. Either a a -> a
fromEither Either Comment Comment
entryText) Bool -> Bool -> Bool
&& Transaction -> Bool
transactionBalanced Transaction
trans
-> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step 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 (forall a. Either a a -> a
fromEither Either Comment Comment
entryText)
-> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Comment
"Transaction not balanced! Please balance your transaction before adding it to the journal."
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step forall a b. (a -> b) -> a -> b
$
Comment -> Transaction -> Comment -> Step
AmountQuestion (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 (forall a. Either a a -> a
fromEither Either Comment Comment
entryText) of
Left String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String -> Comment
T.pack String
err)
Right MixedAmount
amount -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step 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
_
| forall a. Either a a -> a
fromEither Either Comment Comment
entryText forall a. Eq a => a -> a -> Bool
== Comment
"y" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Transaction -> MaybeStep
Finished Transaction
trans
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step 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
_ -> forall a b. a -> Either a b
Left Comment
"Already at oldest step in current transaction"
DescriptionQuestion Day
_ Comment
comment -> forall (m :: * -> *) a. Monad m => a -> m a
return (Comment -> Step
DateQuestion Comment
comment)
AccountQuestion Transaction
trans Comment
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 (forall a. [a] -> a
last [Posting]
ps)) Transaction
trans { tpostings :: [Posting]
HL.tpostings = forall a. [a] -> [a]
init [Posting]
ps } (Posting -> Comment
HL.pcomment (forall a. [a] -> a
last [Posting]
ps))
AmountQuestion Comment
_ Transaction
trans Comment
comment -> forall a b. b -> Either a b
Right 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Comment
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Right Day
date -> 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
let descs :: [Comment]
descs = Journal -> [Comment]
HL.journalDescriptions Journal
j
in forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Journal -> Comment -> Comment -> Ordering
descUses Journal
j) forall a b. (a -> b) -> a -> b
$ 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
let names :: [Comment]
names = Journal -> [Comment]
accountsByFrequency Journal
j
in 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 {}) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ String -> Comment
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> String
HL.showMixedAmount 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
_) = 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
_) =
forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> Day -> Comment
printDate DateFormat
dateFormat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Day
getLocalDay
suggest Journal
_ DateFormat
_ (DescriptionQuestion Day
_ Comment
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
suggest Journal
journal DateFormat
_ (AccountQuestion Transaction
trans Comment
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if Transaction -> Int
numPostings Transaction
trans forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& Transaction -> Bool
transactionBalanced Transaction
trans
then forall a. Maybe a
Nothing
else Posting -> Comment
HL.paccount 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Comment
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> String
HL.showMixedAmount) forall a b. (a -> b) -> a -> b
$
case Journal -> Transaction -> Maybe Transaction
findLastSimilar Journal
journal Transaction
trans of
Maybe Transaction
Nothing
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Transaction -> [Posting]
HL.tpostings Transaction
trans)
-> forall a. Maybe a
Nothing
| Bool
otherwise
-> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Transaction -> MixedAmount
negativeAmountSum Transaction
trans
Just Transaction
last
| Transaction -> Bool
transactionBalanced Transaction
trans
-> Posting -> MixedAmount
HL.pamount 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Comment -> Transaction -> Maybe Posting
findPostingByAcc Comment
account Transaction
last)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just (Transaction -> MixedAmount
negativeAmountSum Transaction
trans)
| Bool
otherwise
-> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Transaction -> MixedAmount
negativeAmountSum Transaction
trans
suggest Journal
_ DateFormat
_ (FinalQuestion Transaction
_ Bool
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 { tcomment :: Comment
HL.tcomment = Comment
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 { tcomment :: Comment
HL.tcomment = Comment
comment }) Comment
comment'
AmountQuestion Comment
name Transaction
trans Comment
comment' ->
Comment -> Transaction -> Comment -> Step
AmountQuestion Comment
name (Transaction
trans { tcomment :: Comment
HL.tcomment = Comment
comment }) Comment
comment'
FinalQuestion Transaction
trans Bool
duplicate -> Transaction -> Bool -> Step
FinalQuestion Transaction
trans { tcomment :: Comment
HL.tcomment = Comment
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 forall a. Eq a => a -> a -> Bool
== MatchAlgo
Fuzzy Bool -> Bool -> Bool
&& (Char -> Bool) -> Comment -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
':') Comment
b' = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Comment -> [Comment] -> Bool
`fuzzyMatch` Comment -> Comment -> [Comment]
T.splitOn Comment
":" Comment
b') (Comment -> [Comment]
T.words Comment
a')
| Bool
otherwise = 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 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 forall a. Eq a => a -> a -> Bool
== Char
c2 -> Comment -> [Comment] -> Bool
fuzzyMatch Comment
queryRest (Comment
partRest 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
{ paccount :: Comment
HL.paccount = Comment
account
, pamount :: MixedAmount
HL.pamount = MixedAmount
amount
, pcomment :: Comment
HL.pcomment = Comment
comment
}
addPosting :: HL.Posting -> HL.Transaction -> HL.Transaction
addPosting :: Posting -> Transaction -> Transaction
addPosting Posting
p Transaction
t = Transaction
t { tpostings :: [Posting]
HL.tpostings = Transaction -> [Posting]
HL.tpostings Transaction
t forall a. [a] -> [a] -> [a]
++ [Posting
p] }
trySumAmount :: HL.Journal -> Text -> Maybe HL.MixedAmount
trySumAmount :: Journal -> Comment -> Maybe MixedAmount
trySumAmount Journal
ctx = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (forall {t :: * -> *}. Foldable t => Posting -> t Posting -> Bool
`notContainedIn` [Posting]
curPostings) [Posting]
refPostings
in 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
curPostings in
if Int
postingsEntered forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
refPostings then
forall a. a -> Maybe a
Just ([Posting]
refPostings forall a. [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 =
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Transaction -> Day
HL.tdate) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a. [a] -> Maybe [a]
listToMaybe' (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Transaction -> Comment
HL.tdescription) Transaction
desc) 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 -> forall a. [a] -> Maybe [a]
listToMaybe' (Journal -> [Transaction]
HL.jtxns Journal
journal) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Transaction -> Transaction -> Maybe Posting
suggestCorrespondingPosting Transaction
trans forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last
findPostingByAcc :: HL.AccountName -> HL.Transaction -> Maybe HL.Posting
findPostingByAcc :: Comment -> Transaction -> Maybe Posting
findPostingByAcc Comment
account = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==Comment
account) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Comment
HL.paccount) 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
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (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 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 = (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a -> b) -> [a] -> [b]
map (Amount -> Comment
HL.acommodity 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' [] = forall a. Maybe a
Nothing
listToMaybe' [a]
ls = forall a. a -> Maybe a
Just [a]
ls
numPostings :: HL.Transaction -> Int
numPostings :: Transaction -> Int
numPostings = forall (t :: * -> *) a. Foldable t => t a -> Int
length 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 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 = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Comment -> HashMap Comment (Sum Int) -> HashMap Comment (Sum Int)
count forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Comment
HL.tdescription) forall k v. HashMap k v
HM.empty 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 = forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just Sum Int
1)
accountsByFrequency :: HL.Journal -> [HL.AccountName]
accountsByFrequency :: Journal -> [Comment]
accountsByFrequency Journal
journal =
let
usedAccounts :: [Comment]
usedAccounts = 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Comment -> HashMap Comment Int -> HashMap Comment Int
insertOrPlusOne forall k v. HashMap k v
HM.empty [Comment]
usedAccounts
mapWithSubaccounts :: HashMap Comment Int
mapWithSubaccounts = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {k} {v}.
(Hashable k, Num v) =>
k -> HashMap k v -> HashMap k v
insertIfNotPresent HashMap Comment Int
frequencyMap (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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {k} {v}.
(Hashable k, Num v) =>
k -> HashMap k v -> HashMap k v
insertIfNotPresent HashMap Comment Int
mapWithSubaccounts [Comment]
declaredAccounts
in
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Comment Int
mapWithDeclared))
where
insertOrPlusOne :: Comment -> HashMap Comment Int -> HashMap Comment Int
insertOrPlusOne = forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (forall a. Num a => a -> a -> a
+Int
1))
insertIfNotPresent :: k -> HashMap k v -> HashMap k v
insertIfNotPresent k
account = 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 (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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
==Ordering
EQ) 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 =
[ forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Day
HL.tdate, forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Maybe Day
HL.tdate2, forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Comment
HL.tdescription, forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Status
HL.tstatus
, forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Comment
HL.tcode, [Posting] -> [Posting] -> Ordering
cmpPostings forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Transaction -> [Posting]
HL.tpostings
]
postingAttributes :: [Posting -> Posting -> Ordering]
postingAttributes =
[ forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Posting -> Maybe Day
HL.pdate, forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Posting -> Maybe Day
HL.pdate2, forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Posting -> Status
HL.pstatus, forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Posting -> Comment
HL.paccount
, MixedAmount -> MixedAmount -> Ordering
cmpMixedAmount forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Posting -> MixedAmount
HL.pamount, PostingType -> PostingType -> Ordering
cmpPType forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Posting -> PostingType
HL.ptype
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 BalanceAssertion -> BalanceAssertion -> Ordering
cmpBalanceAssertion forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Posting -> Maybe BalanceAssertion
HL.pbalanceassertion
]
amountAttributes :: [Amount -> Amount -> Ordering]
amountAttributes =
[ forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Amount -> Comment
HL.acommodity, forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Amount -> Maybe AmountPrice
HL.aprice, 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 = 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 =
forall a. Monoid a => [a] -> a
mconcat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (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 = forall a. Ord a => a -> a -> Ordering
compare 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 = 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 = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Amount -> Amount -> Ordering
cmpAmount forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
HL.amounts MixedAmount
as1
sortedAs2 :: [Amount]
sortedAs2 = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Amount -> Amount -> Ordering
cmpAmount forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
HL.amounts MixedAmount
as2
in
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
forall a. Ord a => a -> a -> Ordering
compare (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
HL.amounts MixedAmount
as1) (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
HL.amounts MixedAmount
as2) forall a. a -> [a] -> [a]
: 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 = forall a b. [a -> b -> Ordering] -> a -> b -> Ordering
lexical [forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp BalanceAssertion -> Amount
HL.baamount, forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp BalanceAssertion -> Bool
HL.batotal]
sortPostings :: [HL.Posting] -> [HL.Posting]
sortPostings :: [Posting] -> [Posting]
sortPostings = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (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 = forall a. Ord a => a -> a -> Ordering
compare 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 = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
fromEither :: Either a a -> a
fromEither :: forall a. Either a a -> a
fromEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id