FIX intervals not included

This commit is contained in:
Nathan Dwarshuis 2023-04-12 22:58:31 -04:00
parent 70d8ad8f34
commit ae4f5795f8
2 changed files with 17 additions and 3 deletions

View File

@ -154,7 +154,7 @@ type IntAllocations = ([BoundAllocation], [BoundAllocation], [BoundAllocation])
-- TODO this should actually error if there is no ultimate end date -- TODO this should actually error if there is no ultimate end date
sortAllo :: IntervalAllocation -> EitherErrs BoundAllocation sortAllo :: IntervalAllocation -> EitherErrs BoundAllocation
sortAllo a@Allocation_ {alloAmts = as} = do sortAllo a@Allocation_ {alloAmts = as} = do
bs <- fmap reverse <$> foldBounds (Right []) $ L.sort as bs <- fmap reverse <$> foldBounds (Right []) $ L.sortOn taWhen as
return $ a {alloAmts = L.sort bs} return $ a {alloAmts = L.sort bs}
where where
foldBounds acc [] = acc foldBounds acc [] = acc
@ -241,6 +241,7 @@ data BudgetMeta = BudgetMeta
, bmCur :: !BudgetCurrency , bmCur :: !BudgetCurrency
, bmName :: !T.Text , bmName :: !T.Text
} }
deriving (Show)
data BudgetTx = BudgetTx data BudgetTx = BudgetTx
{ btMeta :: !BudgetMeta { btMeta :: !BudgetMeta
@ -250,11 +251,13 @@ data BudgetTx = BudgetTx
, btValue :: !Rational , btValue :: !Rational
, btDesc :: !T.Text , btDesc :: !T.Text
} }
deriving (Show)
data BudgetTxType = BudgetTxType data BudgetTxType = BudgetTxType
{ bttType :: !AmountType { bttType :: !AmountType
, bttTx :: !BudgetTx , bttTx :: !BudgetTx
} }
deriving (Show)
insertIncome insertIncome
:: MonadFinance m :: MonadFinance m
@ -308,7 +311,7 @@ selectAllos day a@Allocation_ {alloAmts = as} = case select [] as of
where where
select acc [] = acc select acc [] = acc
select acc (x : xs) select acc (x : xs)
| (fst $ taWhen x) < day = select acc xs | day < fst (taWhen x) = select acc xs
| inBounds (taWhen x) day = select (taAmt x : acc) xs | inBounds (taWhen x) day = select (taAmt x : acc) xs
| otherwise = acc | otherwise = acc

View File

@ -192,6 +192,8 @@ deriving instance Hashable Budget
deriving instance FromDhall Budget deriving instance FromDhall Budget
deriving instance Show TaggedAcnt
deriving instance Eq TaggedAcnt deriving instance Eq TaggedAcnt
deriving instance Hashable TaggedAcnt deriving instance Hashable TaggedAcnt
@ -219,16 +221,22 @@ deriving instance Hashable Income
deriving instance FromDhall Income deriving instance FromDhall Income
deriving instance Show Amount
deriving instance Eq Amount deriving instance Eq Amount
deriving instance Ord Amount deriving instance Ord Amount
deriving instance Hashable Amount deriving instance Hashable Amount
deriving instance Show Exchange
deriving instance Eq Exchange deriving instance Eq Exchange
deriving instance Hashable Exchange deriving instance Hashable Exchange
deriving instance Show BudgetCurrency
deriving instance Eq BudgetCurrency deriving instance Eq BudgetCurrency
deriving instance Hashable BudgetCurrency deriving instance Hashable BudgetCurrency
@ -238,6 +246,7 @@ data Allocation_ a = Allocation_
, alloAmts :: [a] , alloAmts :: [a]
, alloCur :: BudgetCurrency , alloCur :: BudgetCurrency
} }
deriving (Show)
type Allocation = Allocation_ Amount type Allocation = Allocation_ Amount
@ -269,6 +278,8 @@ fromPersistText what (PersistText t) = case readMaybe $ T.unpack t of
fromPersistText what x = fromPersistText what x =
Left $ T.unwords ["error when deserializing", what, "; got", T.pack (show x)] Left $ T.unwords ["error when deserializing", what, "; got", T.pack (show x)]
deriving instance Show AmountType
deriving instance Eq AmountType deriving instance Eq AmountType
deriving instance Ord AmountType deriving instance Ord AmountType
@ -280,7 +291,7 @@ data TimeAmount a = TimeAmount
, taAmt :: Amount , taAmt :: Amount
, taAmtType :: AmountType , taAmtType :: AmountType
} }
deriving (Eq, Ord, Functor, Generic, FromDhall, Hashable, Foldable, Traversable) deriving (Show, Eq, Ord, Functor, Generic, FromDhall, Hashable, Foldable, Traversable)
type DateAmount = TimeAmount DatePat type DateAmount = TimeAmount DatePat