{-# 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
       ) 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 hiding (parseTime)
import qualified Hledger as HL
import           Data.Foldable
import           Control.Applicative

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
/= :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c== :: 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
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
(MaybeStep -> MaybeStep -> Bool)
-> (MaybeStep -> MaybeStep -> Bool) -> Eq MaybeStep
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
(Int -> MaybeStep -> ShowS)
-> (MaybeStep -> String)
-> ([MaybeStep] -> ShowS)
-> Show MaybeStep
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
(MatchAlgo -> MatchAlgo -> Bool)
-> (MatchAlgo -> MatchAlgo -> Bool) -> Eq MatchAlgo
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
(Int -> MatchAlgo -> ShowS)
-> (MatchAlgo -> String)
-> ([MatchAlgo] -> ShowS)
-> Show MatchAlgo
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 Text Text
-> Step
-> IO (Either Text MaybeStep)
nextStep Journal
journal DateFormat
dateFormat Either Text Text
entryText Step
current = case Step
current of
  DateQuestion Text
comment ->
    (Day -> MaybeStep) -> Either Text Day -> Either Text MaybeStep
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 -> Text -> Step) -> Text -> Day -> Step
forall a b c. (a -> b -> c) -> b -> a -> c
flip Day -> Text -> Step
DescriptionQuestion Text
comment)
       (Either Text Day -> Either Text MaybeStep)
-> IO (Either Text Day) -> IO (Either Text MaybeStep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> IO (Either Text Day))
-> (Text -> IO (Either Text Day))
-> Either Text Text
-> IO (Either Text Day)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (DateFormat -> Text -> IO (Either Text Day)
parseDateWithToday DateFormat
dateFormat) Text -> IO (Either Text Day)
parseHLDateWithToday Either Text Text
entryText

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

  FinalQuestion Transaction
trans Bool
_
    | Either Text Text -> Text
forall a. Either a a -> a
fromEither Either Text Text
entryText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"y" -> Either Text MaybeStep -> IO (Either Text MaybeStep)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text MaybeStep -> IO (Either Text MaybeStep))
-> Either Text MaybeStep -> IO (Either Text MaybeStep)
forall a b. (a -> b) -> a -> b
$ MaybeStep -> Either Text MaybeStep
forall a b. b -> Either a b
Right (MaybeStep -> Either Text MaybeStep)
-> MaybeStep -> Either Text MaybeStep
forall a b. (a -> b) -> a -> b
$ Transaction -> MaybeStep
Finished Transaction
trans
    | Bool
otherwise -> Either Text MaybeStep -> IO (Either Text MaybeStep)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text MaybeStep -> IO (Either Text MaybeStep))
-> Either Text MaybeStep -> IO (Either Text MaybeStep)
forall a b. (a -> b) -> a -> b
$ MaybeStep -> Either Text MaybeStep
forall a b. b -> Either a b
Right (MaybeStep -> Either Text MaybeStep)
-> MaybeStep -> Either Text MaybeStep
forall a b. (a -> b) -> a -> b
$ Step -> MaybeStep
Step (Step -> MaybeStep) -> Step -> MaybeStep
forall a b. (a -> b) -> a -> b
$ Transaction -> Text -> Step
AccountQuestion Transaction
trans Text
""

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

context :: HL.Journal -> MatchAlgo -> DateFormat -> Text -> Step -> IO [Text]
context :: Journal -> MatchAlgo -> DateFormat -> Text -> Step -> IO [Text]
context Journal
_ MatchAlgo
_ DateFormat
dateFormat Text
entryText (DateQuestion Text
_) = DateFormat -> Text -> IO (Either Text Day)
parseDateWithToday DateFormat
dateFormat Text
entryText IO (Either Text Day) -> (Either Text Day -> IO [Text]) -> IO [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left Text
_ -> [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Right Day
date -> [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Day -> Text
HL.showDate Day
date]
context Journal
j MatchAlgo
matchAlgo DateFormat
_ Text
entryText (DescriptionQuestion Day
_ Text
_) = [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$
  let descs :: [Text]
descs = Journal -> [Text]
HL.journalDescriptions Journal
j
  in (Text -> Text -> Ordering) -> [Text] -> [Text]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Journal -> Text -> Text -> Ordering
descUses Journal
j) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (MatchAlgo -> Text -> Text -> Bool
matches MatchAlgo
matchAlgo Text
entryText) [Text]
descs
context Journal
j MatchAlgo
matchAlgo DateFormat
_ Text
entryText (AccountQuestion Transaction
_ Text
_) = [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$
  let names :: [Text]
names = Journal -> [Text]
accountsByFrequency Journal
j
  in  (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (MatchAlgo -> Text -> Text -> Bool
matches MatchAlgo
matchAlgo Text
entryText) [Text]
names
context Journal
journal MatchAlgo
_ DateFormat
_ Text
entryText (AmountQuestion Text
_ Transaction
_ Text
_) = [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$
  Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> (MixedAmount -> String) -> MixedAmount -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> String
HL.showMixedAmount (MixedAmount -> Text) -> Maybe MixedAmount -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> Text -> Maybe MixedAmount
trySumAmount Journal
journal Text
entryText
context Journal
_ MatchAlgo
_ DateFormat
_ Text
_  (FinalQuestion Transaction
_ Bool
_) = [Text] -> IO [Text]
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 Text)
suggest Journal
_ DateFormat
dateFormat (DateQuestion Text
_) =
  Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Day -> Text) -> Day -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> Day -> Text
printDate DateFormat
dateFormat (Day -> Maybe Text) -> IO Day -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Day
getLocalDay
suggest Journal
_ DateFormat
_ (DescriptionQuestion Day
_ Text
_) = Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
suggest Journal
journal DateFormat
_ (AccountQuestion Transaction
trans Text
_) = Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
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 Text
forall a. Maybe a
Nothing
    else Posting -> Text
HL.paccount (Posting -> Text) -> Maybe Posting -> Maybe Text
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 Text
account Transaction
trans Text
_) = Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (MixedAmount -> Text) -> Maybe MixedAmount -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack (String -> Text) -> (MixedAmount -> String) -> MixedAmount -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> String
HL.showMixedAmount) (Maybe MixedAmount -> Maybe Text)
-> Maybe MixedAmount -> Maybe Text
forall a b. (a -> b) -> a -> b
$ do
  case Journal -> Transaction -> Maybe Transaction
findLastSimilar Journal
journal Transaction
trans of
    Maybe Transaction
Nothing
      | [Posting] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Transaction -> [Posting]
HL.tpostings Transaction
trans)
        -> Maybe MixedAmount
forall a. Maybe a
Nothing  -- Don't suggest an amount for first account
      | 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 Bool -> Bool -> Bool
|| (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
<$> (Text -> Transaction -> Maybe Posting
findPostingByAcc Text
account Transaction
last)
      | 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 Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"y"

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

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

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

setTransactionComment :: Comment -> Step -> Step
setTransactionComment :: Text -> Step -> Step
setTransactionComment Text
comment Step
step = case Step
step of
  DateQuestion Text
_ -> Text -> Step
DateQuestion Text
comment
  DescriptionQuestion Day
date Text
_ -> Day -> Text -> Step
DescriptionQuestion Day
date Text
comment
  AccountQuestion Transaction
trans Text
comment' ->
    Transaction -> Text -> Step
AccountQuestion (Transaction
trans { tcomment :: Text
HL.tcomment = Text
comment }) Text
comment'
  AmountQuestion Text
name Transaction
trans Text
comment' ->
    Text -> Transaction -> Text -> Step
AmountQuestion Text
name (Transaction
trans { tcomment :: Text
HL.tcomment = Text
comment }) Text
comment'
  FinalQuestion Transaction
trans Bool
duplicate -> Transaction -> Bool -> Step
FinalQuestion Transaction
trans { tcomment :: Text
HL.tcomment = Text
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 -> Text -> Text -> Bool
matches MatchAlgo
algo Text
a Text
b
  | Text -> Bool
T.null Text
a = Bool
False
  | Bool
otherwise = Text -> Text -> Bool
matches' (Text -> Text
T.toCaseFold Text
a) (Text -> Text
T.toCaseFold Text
b)
  where
    matches' :: Text -> Text -> Bool
matches' Text
a' Text
b'
      | MatchAlgo
algo MatchAlgo -> MatchAlgo -> Bool
forall a. Eq a => a -> a -> Bool
== MatchAlgo
Fuzzy Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
b' = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> [Text] -> Bool
`fuzzyMatch` (Text -> Text -> [Text]
T.splitOn Text
":" Text
b')) (Text -> [Text]
T.words Text
a')
      | Bool
otherwise = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Text -> Bool
`T.isInfixOf` Text
b') (Text -> [Text]
T.words Text
a')

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

post' :: HL.AccountName -> HL.MixedAmount -> Comment -> HL.Posting
post' :: Text -> MixedAmount -> Text -> Posting
post' Text
account MixedAmount
amount Text
comment = Posting
HL.nullposting
  { paccount :: Text
HL.paccount = Text
account
  , pamount :: MixedAmount
HL.pamount = MixedAmount
amount
  , pcomment :: Text
HL.pcomment = Text
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) [Posting] -> [Posting] -> [Posting]
forall a. [a] -> [a] -> [a]
++ [Posting
p] }

trySumAmount :: HL.Journal -> Text -> Maybe HL.MixedAmount
trySumAmount :: Journal -> Text -> 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)
-> (Text -> Either String MixedAmount) -> Text -> Maybe MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Text -> 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]) -> [Transaction] -> [[Posting]]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> [Posting]
HL.tpostings [Transaction
reference, 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 ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (Posting -> Text) -> Posting -> Posting -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Posting -> Text
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 (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 (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. [a] -> Int -> a
!! Int
postingsEntered)
  else
    Transaction -> Transaction -> Maybe Posting
suggestNextPosting Transaction
current Transaction
reference
  where [[Posting]
refPostings, [Posting]
curPostings] = (Transaction -> [Posting]) -> [Transaction] -> [[Posting]]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> [Posting]
HL.tpostings [Transaction
reference, 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 ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (Transaction -> Text) -> Transaction -> Transaction -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Transaction -> Text
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] -> Transaction
forall a. [a] -> a
last ([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' (Journal -> [Transaction]
HL.jtxns Journal
journal)) Maybe Transaction
-> (Transaction -> Maybe Posting) -> Maybe Posting
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Transaction -> Transaction -> Maybe Posting
suggestCorrespondingPosting Transaction
trans)

-- | Return the first Posting that matches the given account name in the transaction
findPostingByAcc :: HL.AccountName -> HL.Transaction -> Maybe HL.Posting
findPostingByAcc :: Text -> Transaction -> Maybe Posting
findPostingByAcc Text
account = (Posting -> Bool) -> [Posting] -> Maybe Posting
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
account) (Text -> Bool) -> (Posting -> Text) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Text
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 (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 -> Text
HL.paccount Posting
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Posting -> Text
HL.paccount Posting
b
                   Bool -> Bool -> Bool
&& Posting -> MixedAmount
HL.pamount Posting
a  MixedAmount -> MixedAmount -> Bool
forall a. Eq a => a -> a -> Bool
== Posting -> MixedAmount
HL.pamount Posting
b


listToMaybe' :: [a] -> Maybe [a]
listToMaybe' :: [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 (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 Transaction
trans = Maybe (Map Text AmountStyle) -> Transaction -> Bool
HL.isTransactionBalanced Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing Transaction
trans

-- | 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 -> Text -> Text -> 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)
-> (Text -> Down (Maybe (Sum Int))) -> Text -> Text -> 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)))
-> (Text -> Maybe (Sum Int)) -> Text -> Down (Maybe (Sum Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> HashMap Text (Sum Int) -> Maybe (Sum Int))
-> HashMap Text (Sum Int) -> Text -> Maybe (Sum Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashMap Text (Sum Int) -> Maybe (Sum Int)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap Text (Sum Int)
usesMap)
  where usesMap :: HashMap Text (Sum Int)
usesMap = (Transaction -> HashMap Text (Sum Int) -> HashMap Text (Sum Int))
-> HashMap Text (Sum Int)
-> [Transaction]
-> HashMap Text (Sum Int)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text -> HashMap Text (Sum Int) -> HashMap Text (Sum Int)
count (Text -> HashMap Text (Sum Int) -> HashMap Text (Sum Int))
-> (Transaction -> Text)
-> Transaction
-> HashMap Text (Sum Int)
-> HashMap Text (Sum Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
HL.tdescription) HashMap Text (Sum Int)
forall k v. HashMap k v
HM.empty ([Transaction] -> HashMap Text (Sum Int))
-> [Transaction] -> HashMap Text (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 :: Text -> HashMap Text (Sum Int) -> HashMap Text (Sum Int)
count = (Maybe (Sum Int) -> Maybe (Sum Int))
-> Text -> HashMap Text (Sum Int) -> HashMap Text (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 -> [Text]
accountsByFrequency Journal
journal =
  let
    usedAccounts :: [Text]
usedAccounts = (Posting -> Text) -> [Posting] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Text
HL.paccount (Journal -> [Posting]
HL.journalPostings Journal
journal)
    HashMap Text Int
frequencyMap :: HM.HashMap HL.AccountName Int = (Text -> HashMap Text Int -> HashMap Text Int)
-> HashMap Text Int -> [Text] -> HashMap Text Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> HashMap Text Int -> HashMap Text Int
insertOrPlusOne HashMap Text Int
forall k v. HashMap k v
HM.empty [Text]
usedAccounts
    mapWithSubaccounts :: HashMap Text Int
mapWithSubaccounts = (Text -> HashMap Text Int -> HashMap Text Int)
-> HashMap Text Int -> [Text] -> HashMap Text Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> HashMap Text Int -> HashMap Text Int
forall k b.
(Eq k, Hashable k, Num b) =>
k -> HashMap k b -> HashMap k b
insertIfNotPresent HashMap Text Int
frequencyMap (HashMap Text Int -> [Text]
forall v. HashMap Text v -> [Text]
subaccounts HashMap Text Int
frequencyMap)
    declaredAccounts :: [Text]
declaredAccounts = [Text] -> [Text]
HL.expandAccountNames (Journal -> [Text]
HL.journalAccountNamesDeclared Journal
journal)
    mapWithDeclared :: HashMap Text Int
mapWithDeclared = (Text -> HashMap Text Int -> HashMap Text Int)
-> HashMap Text Int -> [Text] -> HashMap Text Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> HashMap Text Int -> HashMap Text Int
forall k b.
(Eq k, Hashable k, Num b) =>
k -> HashMap k b -> HashMap k b
insertIfNotPresent HashMap Text Int
mapWithSubaccounts [Text]
declaredAccounts
  in
    ((Text, Int) -> Text) -> [(Text, Int)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Int) -> Text
forall a b. (a, b) -> a
fst (((Text, Int) -> (Text, Int) -> Ordering)
-> [(Text, Int)] -> [(Text, 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)
-> ((Text, Int) -> Down Int)
-> (Text, Int)
-> (Text, 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)
-> ((Text, Int) -> Int) -> (Text, Int) -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Int) -> Int
forall a b. (a, b) -> b
snd)) (HashMap Text Int -> [(Text, Int)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Int
mapWithDeclared))


  where
    insertOrPlusOne :: Text -> HashMap Text Int -> HashMap Text Int
insertOrPlusOne = (Maybe Int -> Maybe Int)
-> Text -> HashMap Text Int -> HashMap Text 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 b -> HashMap k b
insertIfNotPresent k
account = (b -> b -> b) -> k -> b -> HashMap k b -> HashMap k b
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith ((b -> b -> b) -> b -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> b -> b
forall a b. a -> b -> a
const) k
account b
0
    subaccounts :: HashMap Text v -> [Text]
subaccounts HashMap Text v
m = [Text] -> [Text]
HL.expandAccountNames (HashMap Text v -> [Text]
forall k v. HashMap k v -> [k]
HM.keys HashMap Text 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 -> Text) -> Transaction -> Transaction -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Text
HL.tdescription, (Transaction -> Status) -> Transaction -> Transaction -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Status
HL.tstatus
      , (Transaction -> Text) -> Transaction -> Transaction -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Transaction -> Text
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 -> Text) -> Posting -> Posting -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Posting -> Text
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Ordering -> Ordering
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 (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 -> Text) -> Amount -> Amount -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
cmp Amount -> Text
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 (HL.Mixed [Amount]
as1) (HL.Mixed [Amount]
as2) =
      let
        sortedAs1 :: [Amount]
sortedAs1 = (Amount -> Amount -> Ordering) -> [Amount] -> [Amount]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Amount -> Amount -> Ordering
cmpAmount [Amount]
as1
        sortedAs2 :: [Amount]
sortedAs2 = (Amount -> Amount -> Ordering) -> [Amount] -> [Amount]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Amount -> Amount -> Ordering
cmpAmount [Amount]
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 (t :: * -> *) a. Foldable t => t a -> Int
length [Amount]
as1) ([Amount] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Amount]
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 :: (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 :: [a -> b -> Ordering] -> a -> b -> Ordering
lexical = [a -> b -> Ordering] -> a -> b -> Ordering
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold -- hehe

fromEither :: Either a a -> a
fromEither :: 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