REF use newtypes for budget and tx desc
This commit is contained in:
parent
642ebb4727
commit
901882b79f
|
@ -78,7 +78,7 @@ sortAllo a@Allocation {alloAmts = as} = do
|
||||||
readIncome
|
readIncome
|
||||||
:: (MonadInsertError m, MonadFinance m)
|
:: (MonadInsertError m, MonadFinance m)
|
||||||
=> CommitR
|
=> CommitR
|
||||||
-> T.Text
|
-> BudgetName
|
||||||
-> IntAllocations
|
-> IntAllocations
|
||||||
-> DaySpan
|
-> DaySpan
|
||||||
-> Income
|
-> Income
|
||||||
|
@ -154,7 +154,7 @@ readIncome
|
||||||
, txDate = day
|
, txDate = day
|
||||||
, txPrimary = Left primary
|
, txPrimary = Left primary
|
||||||
, txOther = []
|
, txOther = []
|
||||||
, txDescr = ""
|
, txDescr = TxDesc ""
|
||||||
, txBudget = name
|
, txBudget = name
|
||||||
, txPriority = incPriority
|
, txPriority = incPriority
|
||||||
}
|
}
|
||||||
|
|
|
@ -298,7 +298,7 @@ currencyMap =
|
||||||
. fmap
|
. fmap
|
||||||
( \e ->
|
( \e ->
|
||||||
( currencyRSymbol $ entityVal e
|
( currencyRSymbol $ entityVal e
|
||||||
, CurrencyPrec (entityKey e) $ fromIntegral $ currencyRPrecision $ entityVal e
|
, CurrencyPrec (entityKey e) $ currencyRPrecision $ entityVal e
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -517,7 +517,7 @@ readUpdates hashes = do
|
||||||
, utToRO = toRO
|
, utToRO = toRO
|
||||||
, utFromUnk = fromUnk
|
, utFromUnk = fromUnk
|
||||||
, utToUnk = toUnk
|
, utToUnk = toUnk
|
||||||
, utTotalValue = realFracToDecimal prec' tot
|
, utTotalValue = realFracToDecimal' prec' tot
|
||||||
, utBudget = E.unValue name
|
, utBudget = E.unValue name
|
||||||
, utPriority = E.unValue pri
|
, utPriority = E.unValue pri
|
||||||
}
|
}
|
||||||
|
@ -656,7 +656,7 @@ splitDeferredValue prec p = do
|
||||||
readDeferredValue :: Precision -> (EntryRId, EntryR) -> InsertExcept (Either UEBlank (Either UE_RO UEUnk))
|
readDeferredValue :: Precision -> (EntryRId, EntryR) -> InsertExcept (Either UEBlank (Either UE_RO UEUnk))
|
||||||
readDeferredValue prec (k, e) = case (entryRCachedValue e, entryRCachedType e) of
|
readDeferredValue prec (k, e) = case (entryRCachedValue e, entryRCachedType e) of
|
||||||
(Nothing, Just TFixed) -> return $ Right $ Left $ makeRoUE prec e
|
(Nothing, Just TFixed) -> return $ Right $ Left $ makeRoUE prec e
|
||||||
(Just v, Just TBalance) -> go $ fmap EVBalance $ makeUE k e $ realFracToDecimal prec v
|
(Just v, Just TBalance) -> go $ fmap EVBalance $ makeUE k e $ realFracToDecimal' prec v
|
||||||
(Just v, Just TPercent) -> go $ fmap EVPercent $ makeUE k e $ fromRational v
|
(Just v, Just TPercent) -> go $ fmap EVPercent $ makeUE k e $ fromRational v
|
||||||
(Nothing, Nothing) -> return $ Left $ makeUnkUE k e
|
(Nothing, Nothing) -> return $ Left $ makeUnkUE k e
|
||||||
_ -> throwError $ InsertException undefined
|
_ -> throwError $ InsertException undefined
|
||||||
|
@ -667,7 +667,7 @@ makeUE :: i -> EntryR -> v -> UpdateEntry i v
|
||||||
makeUE k e v = UpdateEntry k (entryRAccount e) v (entryRIndex e)
|
makeUE k e v = UpdateEntry k (entryRAccount e) v (entryRIndex e)
|
||||||
|
|
||||||
makeRoUE :: Precision -> EntryR -> UpdateEntry () StaticValue
|
makeRoUE :: Precision -> EntryR -> UpdateEntry () StaticValue
|
||||||
makeRoUE prec e = makeUE () e $ StaticValue (realFracToDecimal prec $ entryRValue e)
|
makeRoUE prec e = makeUE () e $ StaticValue (realFracToDecimal' prec $ entryRValue e)
|
||||||
|
|
||||||
makeUnkUE :: EntryRId -> EntryR -> UpdateEntry EntryRId ()
|
makeUnkUE :: EntryRId -> EntryR -> UpdateEntry EntryRId ()
|
||||||
makeUnkUE k e = makeUE k e ()
|
makeUnkUE k e = makeUE k e ()
|
||||||
|
|
|
@ -284,7 +284,7 @@ matches
|
||||||
val = valMatches spVal $ toRational trAmount
|
val = valMatches spVal $ toRational trAmount
|
||||||
date = maybe True (`dateMatches` trDate) spDate
|
date = maybe True (`dateMatches` trDate) spDate
|
||||||
other = foldM (\a o -> (a &&) <$> otherMatches trOther o) True spOther
|
other = foldM (\a o -> (a &&) <$> otherMatches trOther o) True spOther
|
||||||
desc = maybe (return True) (matchMaybe trDesc . snd) spDesc
|
desc = maybe (return True) (matchMaybe (unTxDesc trDesc) . snd) spDesc
|
||||||
convert tg = MatchPass <$> toTx (fromIntegral spPriority) tg r
|
convert tg = MatchPass <$> toTx (fromIntegral spPriority) tg r
|
||||||
|
|
||||||
toTx :: MonadFinance m => Int -> TxGetter -> TxRecord -> InsertExceptT m (Tx ())
|
toTx :: MonadFinance m => Int -> TxGetter -> TxRecord -> InsertExceptT m (Tx ())
|
||||||
|
@ -539,5 +539,5 @@ parseDecimal (pat, re) s = case matchGroupsMaybe s re of
|
||||||
k <- readSign sign
|
k <- readSign sign
|
||||||
return (k, w)
|
return (k, w)
|
||||||
|
|
||||||
historyName :: T.Text
|
historyName :: BudgetName
|
||||||
historyName = "history"
|
historyName = BudgetName "history"
|
||||||
|
|
|
@ -7,6 +7,7 @@
|
||||||
-- | Types corresponding to the database model
|
-- | Types corresponding to the database model
|
||||||
module Internal.Types.Database where
|
module Internal.Types.Database where
|
||||||
|
|
||||||
|
import Data.Csv (FromField)
|
||||||
import Database.Persist.Sql hiding (Desc, In, Statement)
|
import Database.Persist.Sql hiding (Desc, In, Statement)
|
||||||
import Database.Persist.TH
|
import Database.Persist.TH
|
||||||
import Internal.Types.Dhall
|
import Internal.Types.Dhall
|
||||||
|
@ -56,8 +57,8 @@ AccountPathR sql=account_paths
|
||||||
TransactionR sql=transactions
|
TransactionR sql=transactions
|
||||||
commit CommitRId
|
commit CommitRId
|
||||||
date Day
|
date Day
|
||||||
description T.Text
|
description TxDesc
|
||||||
budgetName T.Text
|
budgetName BudgetName
|
||||||
priority Int
|
priority Int
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
EntrySetR sql=entry_sets
|
EntrySetR sql=entry_sets
|
||||||
|
@ -82,8 +83,11 @@ TagRelationR sql=tag_relations
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
newtype TxDesc = TxDesc {unTxDesc :: T.Text}
|
||||||
|
deriving newtype (Show, Eq, Ord, PersistField, PersistFieldSql, FromField)
|
||||||
|
|
||||||
newtype Precision = Precision {unPrecision :: Word8}
|
newtype Precision = Precision {unPrecision :: Word8}
|
||||||
deriving newtype (Eq, Ord, Num, Show, PersistField, PersistFieldSql)
|
deriving newtype (Eq, Ord, Num, Show, Real, Enum, Integral, PersistField, PersistFieldSql)
|
||||||
|
|
||||||
type DaySpan = (Day, Int)
|
type DaySpan = (Day, Int)
|
||||||
|
|
||||||
|
|
|
@ -187,8 +187,11 @@ deriving instance Generic PairedTransfer
|
||||||
|
|
||||||
deriving instance FromDhall PairedTransfer
|
deriving instance FromDhall PairedTransfer
|
||||||
|
|
||||||
|
newtype BudgetName = BudgetName {unBudgetName :: T.Text}
|
||||||
|
deriving newtype (Show, Eq, Ord, Hashable, FromDhall, PersistField, PersistFieldSql)
|
||||||
|
|
||||||
data Budget = Budget
|
data Budget = Budget
|
||||||
{ bgtLabel :: Text
|
{ bgtLabel :: BudgetName
|
||||||
, bgtIncomes :: [Income]
|
, bgtIncomes :: [Income]
|
||||||
, bgtPretax :: [MultiAllocation PretaxValue]
|
, bgtPretax :: [MultiAllocation PretaxValue]
|
||||||
, bgtTax :: [MultiAllocation TaxValue]
|
, bgtTax :: [MultiAllocation TaxValue]
|
||||||
|
|
|
@ -93,7 +93,7 @@ data ReadEntry = ReadEntry
|
||||||
, reValue :: !Decimal
|
, reValue :: !Decimal
|
||||||
, reDate :: !Day
|
, reDate :: !Day
|
||||||
, rePriority :: !Int
|
, rePriority :: !Int
|
||||||
, reBudget :: !T.Text
|
, reBudget :: !BudgetName
|
||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
@ -137,7 +137,7 @@ data UpdateEntrySet f t = UpdateEntrySet
|
||||||
, utCurrency :: !CurrencyRId
|
, utCurrency :: !CurrencyRId
|
||||||
, utDate :: !Day
|
, utDate :: !Day
|
||||||
, utTotalValue :: !t
|
, utTotalValue :: !t
|
||||||
, utBudget :: !T.Text
|
, utBudget :: !BudgetName
|
||||||
, utPriority :: !Int
|
, utPriority :: !Int
|
||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
@ -164,7 +164,7 @@ askDBState = asks
|
||||||
data TxRecord = TxRecord
|
data TxRecord = TxRecord
|
||||||
{ trDate :: !Day
|
{ trDate :: !Day
|
||||||
, trAmount :: !Decimal
|
, trAmount :: !Decimal
|
||||||
, trDesc :: !T.Text
|
, trDesc :: !TxDesc
|
||||||
, trOther :: !(M.Map T.Text T.Text)
|
, trOther :: !(M.Map T.Text T.Text)
|
||||||
, trFile :: !FilePath
|
, trFile :: !FilePath
|
||||||
}
|
}
|
||||||
|
@ -209,13 +209,13 @@ data TxCommit = HistoryCommit CommitR | BudgetCommit CommitR T.Text
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
data Tx k = Tx
|
data Tx k = Tx
|
||||||
{ txDescr :: !T.Text
|
{ txDescr :: !TxDesc
|
||||||
, txDate :: !Day
|
, txDate :: !Day
|
||||||
, txPriority :: !Int
|
, txPriority :: !Int
|
||||||
, txPrimary :: !(Either PrimaryEntrySet TransferEntrySet)
|
, txPrimary :: !(Either PrimaryEntrySet TransferEntrySet)
|
||||||
, txOther :: ![Either SecondayEntrySet ShadowEntrySet]
|
, txOther :: ![Either SecondayEntrySet ShadowEntrySet]
|
||||||
, txCommit :: !k
|
, txCommit :: !k
|
||||||
, txBudget :: !T.Text
|
, txBudget :: !BudgetName
|
||||||
}
|
}
|
||||||
deriving (Generic, Show)
|
deriving (Generic, Show)
|
||||||
|
|
||||||
|
@ -231,12 +231,12 @@ data InsertEntrySet = InsertEntrySet
|
||||||
}
|
}
|
||||||
|
|
||||||
data InsertTx = InsertTx
|
data InsertTx = InsertTx
|
||||||
{ itxDescr :: !T.Text
|
{ itxDescr :: !TxDesc
|
||||||
, itxDate :: !Day
|
, itxDate :: !Day
|
||||||
, itxPriority :: !Int
|
, itxPriority :: !Int
|
||||||
, itxEntrySets :: !(NonEmpty InsertEntrySet)
|
, itxEntrySets :: !(NonEmpty InsertEntrySet)
|
||||||
, itxCommit :: !CommitR
|
, itxCommit :: !CommitR
|
||||||
, itxBudget :: !T.Text
|
, itxBudget :: !BudgetName
|
||||||
}
|
}
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
|
|
|
@ -520,7 +520,7 @@ tshowx TxRecord {trDate = d, trAmount = v, trDesc = e, trFile = f} =
|
||||||
[ ("path", T.pack f)
|
[ ("path", T.pack f)
|
||||||
, ("date", T.pack $ iso8601Show d)
|
, ("date", T.pack $ iso8601Show d)
|
||||||
, ("value", tshow v)
|
, ("value", tshow v)
|
||||||
, ("description", doubleQuote e)
|
, ("description", doubleQuote $ unTxDesc e)
|
||||||
]
|
]
|
||||||
|
|
||||||
showMatch :: MatchRe -> T.Text
|
showMatch :: MatchRe -> T.Text
|
||||||
|
@ -700,7 +700,7 @@ binDate (ToUpdate u) = either go go u
|
||||||
where
|
where
|
||||||
go UpdateEntrySet {utDate, utPriority} = (utDate, utPriority)
|
go UpdateEntrySet {utDate, utPriority} = (utDate, utPriority)
|
||||||
|
|
||||||
type BCKey = (CurrencyRId, Text)
|
type BCKey = (CurrencyRId, BudgetName)
|
||||||
|
|
||||||
type ABCKey = (AccountRId, BCKey)
|
type ABCKey = (AccountRId, BCKey)
|
||||||
|
|
||||||
|
@ -835,7 +835,7 @@ updateUnknown k e = do
|
||||||
|
|
||||||
balancePrimaryEntrySet
|
balancePrimaryEntrySet
|
||||||
:: (MonadInsertError m, MonadFinance m)
|
:: (MonadInsertError m, MonadFinance m)
|
||||||
=> T.Text
|
=> BudgetName
|
||||||
-> PrimaryEntrySet
|
-> PrimaryEntrySet
|
||||||
-> StateT EntryBals m InsertEntrySet
|
-> StateT EntryBals m InsertEntrySet
|
||||||
balancePrimaryEntrySet
|
balancePrimaryEntrySet
|
||||||
|
@ -860,7 +860,7 @@ balancePrimaryEntrySet
|
||||||
|
|
||||||
balanceSecondaryEntrySet
|
balanceSecondaryEntrySet
|
||||||
:: (MonadInsertError m, MonadFinance m)
|
:: (MonadInsertError m, MonadFinance m)
|
||||||
=> T.Text
|
=> BudgetName
|
||||||
-> SecondayEntrySet
|
-> SecondayEntrySet
|
||||||
-> StateT EntryBals m InsertEntrySet
|
-> StateT EntryBals m InsertEntrySet
|
||||||
balanceSecondaryEntrySet
|
balanceSecondaryEntrySet
|
||||||
|
@ -992,7 +992,7 @@ findBalance k e = do
|
||||||
expandTransfers
|
expandTransfers
|
||||||
:: (MonadInsertError m, MonadFinance m)
|
:: (MonadInsertError m, MonadFinance m)
|
||||||
=> CommitR
|
=> CommitR
|
||||||
-> T.Text
|
-> BudgetName
|
||||||
-> DaySpan
|
-> DaySpan
|
||||||
-> [PairedTransfer]
|
-> [PairedTransfer]
|
||||||
-> m [Tx CommitR]
|
-> m [Tx CommitR]
|
||||||
|
@ -1001,7 +1001,7 @@ expandTransfers tc name bounds = fmap concat . mapErrors (expandTransfer tc name
|
||||||
expandTransfer
|
expandTransfer
|
||||||
:: (MonadInsertError m, MonadFinance m)
|
:: (MonadInsertError m, MonadFinance m)
|
||||||
=> CommitR
|
=> CommitR
|
||||||
-> T.Text
|
-> BudgetName
|
||||||
-> DaySpan
|
-> DaySpan
|
||||||
-> PairedTransfer
|
-> PairedTransfer
|
||||||
-> m [Tx CommitR]
|
-> m [Tx CommitR]
|
||||||
|
@ -1030,7 +1030,7 @@ expandTransfer tc name bounds Transfer {transAmounts, transTo, transCurrency, tr
|
||||||
, txDate = day
|
, txDate = day
|
||||||
, txPrimary = Right $ entryPair transFrom transTo (cpID cp) desc () v''
|
, txPrimary = Right $ entryPair transFrom transTo (cpID cp) desc () v''
|
||||||
, txOther = []
|
, txOther = []
|
||||||
, txDescr = desc
|
, txDescr = TxDesc desc
|
||||||
, txBudget = name
|
, txBudget = name
|
||||||
, txPriority = fromIntegral pri
|
, txPriority = fromIntegral pri
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue