From 901882b79f0a0a742a48d52785bfb1542cdfdd23 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 16 Jul 2023 00:39:03 -0400 Subject: [PATCH] REF use newtypes for budget and tx desc --- lib/Internal/Budget.hs | 4 ++-- lib/Internal/Database.hs | 8 ++++---- lib/Internal/History.hs | 6 +++--- lib/Internal/Types/Database.hs | 10 +++++++--- lib/Internal/Types/Dhall.hs | 5 ++++- lib/Internal/Types/Main.hs | 14 +++++++------- lib/Internal/Utils.hs | 14 +++++++------- 7 files changed, 34 insertions(+), 27 deletions(-) diff --git a/lib/Internal/Budget.hs b/lib/Internal/Budget.hs index c962af3..1da9539 100644 --- a/lib/Internal/Budget.hs +++ b/lib/Internal/Budget.hs @@ -78,7 +78,7 @@ sortAllo a@Allocation {alloAmts = as} = do readIncome :: (MonadInsertError m, MonadFinance m) => CommitR - -> T.Text + -> BudgetName -> IntAllocations -> DaySpan -> Income @@ -154,7 +154,7 @@ readIncome , txDate = day , txPrimary = Left primary , txOther = [] - , txDescr = "" + , txDescr = TxDesc "" , txBudget = name , txPriority = incPriority } diff --git a/lib/Internal/Database.hs b/lib/Internal/Database.hs index d5af3bf..2b4049b 100644 --- a/lib/Internal/Database.hs +++ b/lib/Internal/Database.hs @@ -298,7 +298,7 @@ currencyMap = . fmap ( \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 , utFromUnk = fromUnk , utToUnk = toUnk - , utTotalValue = realFracToDecimal prec' tot + , utTotalValue = realFracToDecimal' prec' tot , utBudget = E.unValue name , utPriority = E.unValue pri } @@ -656,7 +656,7 @@ splitDeferredValue prec p = do readDeferredValue :: Precision -> (EntryRId, EntryR) -> InsertExcept (Either UEBlank (Either UE_RO UEUnk)) readDeferredValue prec (k, e) = case (entryRCachedValue e, entryRCachedType e) of (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 (Nothing, Nothing) -> return $ Left $ makeUnkUE k e _ -> 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) 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 k e = makeUE k e () diff --git a/lib/Internal/History.hs b/lib/Internal/History.hs index 94e0341..a7522dc 100644 --- a/lib/Internal/History.hs +++ b/lib/Internal/History.hs @@ -284,7 +284,7 @@ matches val = valMatches spVal $ toRational trAmount date = maybe True (`dateMatches` trDate) spDate 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 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 return (k, w) -historyName :: T.Text -historyName = "history" +historyName :: BudgetName +historyName = BudgetName "history" diff --git a/lib/Internal/Types/Database.hs b/lib/Internal/Types/Database.hs index 7d18dcb..15709a9 100644 --- a/lib/Internal/Types/Database.hs +++ b/lib/Internal/Types/Database.hs @@ -7,6 +7,7 @@ -- | Types corresponding to the database model module Internal.Types.Database where +import Data.Csv (FromField) import Database.Persist.Sql hiding (Desc, In, Statement) import Database.Persist.TH import Internal.Types.Dhall @@ -56,8 +57,8 @@ AccountPathR sql=account_paths TransactionR sql=transactions commit CommitRId date Day - description T.Text - budgetName T.Text + description TxDesc + budgetName BudgetName priority Int deriving Show Eq EntrySetR sql=entry_sets @@ -82,8 +83,11 @@ TagRelationR sql=tag_relations deriving Show Eq |] +newtype TxDesc = TxDesc {unTxDesc :: T.Text} + deriving newtype (Show, Eq, Ord, PersistField, PersistFieldSql, FromField) + 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) diff --git a/lib/Internal/Types/Dhall.hs b/lib/Internal/Types/Dhall.hs index 1ea0c60..1a72ea3 100644 --- a/lib/Internal/Types/Dhall.hs +++ b/lib/Internal/Types/Dhall.hs @@ -187,8 +187,11 @@ deriving instance Generic PairedTransfer deriving instance FromDhall PairedTransfer +newtype BudgetName = BudgetName {unBudgetName :: T.Text} + deriving newtype (Show, Eq, Ord, Hashable, FromDhall, PersistField, PersistFieldSql) + data Budget = Budget - { bgtLabel :: Text + { bgtLabel :: BudgetName , bgtIncomes :: [Income] , bgtPretax :: [MultiAllocation PretaxValue] , bgtTax :: [MultiAllocation TaxValue] diff --git a/lib/Internal/Types/Main.hs b/lib/Internal/Types/Main.hs index 4245ece..13764cf 100644 --- a/lib/Internal/Types/Main.hs +++ b/lib/Internal/Types/Main.hs @@ -93,7 +93,7 @@ data ReadEntry = ReadEntry , reValue :: !Decimal , reDate :: !Day , rePriority :: !Int - , reBudget :: !T.Text + , reBudget :: !BudgetName } deriving (Show) @@ -137,7 +137,7 @@ data UpdateEntrySet f t = UpdateEntrySet , utCurrency :: !CurrencyRId , utDate :: !Day , utTotalValue :: !t - , utBudget :: !T.Text + , utBudget :: !BudgetName , utPriority :: !Int } deriving (Show) @@ -164,7 +164,7 @@ askDBState = asks data TxRecord = TxRecord { trDate :: !Day , trAmount :: !Decimal - , trDesc :: !T.Text + , trDesc :: !TxDesc , trOther :: !(M.Map T.Text T.Text) , trFile :: !FilePath } @@ -209,13 +209,13 @@ data TxCommit = HistoryCommit CommitR | BudgetCommit CommitR T.Text deriving (Eq, Ord, Show) data Tx k = Tx - { txDescr :: !T.Text + { txDescr :: !TxDesc , txDate :: !Day , txPriority :: !Int , txPrimary :: !(Either PrimaryEntrySet TransferEntrySet) , txOther :: ![Either SecondayEntrySet ShadowEntrySet] , txCommit :: !k - , txBudget :: !T.Text + , txBudget :: !BudgetName } deriving (Generic, Show) @@ -231,12 +231,12 @@ data InsertEntrySet = InsertEntrySet } data InsertTx = InsertTx - { itxDescr :: !T.Text + { itxDescr :: !TxDesc , itxDate :: !Day , itxPriority :: !Int , itxEntrySets :: !(NonEmpty InsertEntrySet) , itxCommit :: !CommitR - , itxBudget :: !T.Text + , itxBudget :: !BudgetName } deriving (Generic) diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs index da50816..5f43653 100644 --- a/lib/Internal/Utils.hs +++ b/lib/Internal/Utils.hs @@ -520,7 +520,7 @@ tshowx TxRecord {trDate = d, trAmount = v, trDesc = e, trFile = f} = [ ("path", T.pack f) , ("date", T.pack $ iso8601Show d) , ("value", tshow v) - , ("description", doubleQuote e) + , ("description", doubleQuote $ unTxDesc e) ] showMatch :: MatchRe -> T.Text @@ -700,7 +700,7 @@ binDate (ToUpdate u) = either go go u where go UpdateEntrySet {utDate, utPriority} = (utDate, utPriority) -type BCKey = (CurrencyRId, Text) +type BCKey = (CurrencyRId, BudgetName) type ABCKey = (AccountRId, BCKey) @@ -835,7 +835,7 @@ updateUnknown k e = do balancePrimaryEntrySet :: (MonadInsertError m, MonadFinance m) - => T.Text + => BudgetName -> PrimaryEntrySet -> StateT EntryBals m InsertEntrySet balancePrimaryEntrySet @@ -860,7 +860,7 @@ balancePrimaryEntrySet balanceSecondaryEntrySet :: (MonadInsertError m, MonadFinance m) - => T.Text + => BudgetName -> SecondayEntrySet -> StateT EntryBals m InsertEntrySet balanceSecondaryEntrySet @@ -992,7 +992,7 @@ findBalance k e = do expandTransfers :: (MonadInsertError m, MonadFinance m) => CommitR - -> T.Text + -> BudgetName -> DaySpan -> [PairedTransfer] -> m [Tx CommitR] @@ -1001,7 +1001,7 @@ expandTransfers tc name bounds = fmap concat . mapErrors (expandTransfer tc name expandTransfer :: (MonadInsertError m, MonadFinance m) => CommitR - -> T.Text + -> BudgetName -> DaySpan -> PairedTransfer -> m [Tx CommitR] @@ -1030,7 +1030,7 @@ expandTransfer tc name bounds Transfer {transAmounts, transTo, transCurrency, tr , txDate = day , txPrimary = Right $ entryPair transFrom transTo (cpID cp) desc () v'' , txOther = [] - , txDescr = desc + , txDescr = TxDesc desc , txBudget = name , txPriority = fromIntegral pri }