REF use newtype for indices

This commit is contained in:
Nathan Dwarshuis 2023-07-16 12:15:39 -04:00
parent 901882b79f
commit ad5e4a0748
5 changed files with 15 additions and 52 deletions

View File

@ -620,7 +620,7 @@ splitTo prec from0 fromUnk (t0 :| ts) = do
zipPaired zipPaired
:: Precision :: Precision
-> [UEUnk] -> [UEUnk]
-> [(Int, NonEmpty (EntryRId, EntryR))] -> [(EntryIndex, NonEmpty (EntryRId, EntryR))]
-> InsertExcept ([(UEUnk, [UELink])], [UE_RO]) -> InsertExcept ([(UEUnk, [UELink])], [UE_RO])
zipPaired prec = go ([], []) zipPaired prec = go ([], [])
where where
@ -697,7 +697,7 @@ insertTx c InsertTx {itxDate, itxDescr, itxEntrySets, itxBudget, itxPriority} =
mapM_ (uncurry (go esk)) $ zip [0 ..] ts ++ zip (negate <$> [1 ..]) fs mapM_ (uncurry (go esk)) $ zip [0 ..] ts ++ zip (negate <$> [1 ..]) fs
go k i e = void $ insertEntry k i e go k i e = void $ insertEntry k i e
insertEntry :: MonadSqlQuery m => EntrySetRId -> Int -> InsertEntry -> m EntryRId insertEntry :: MonadSqlQuery m => EntrySetRId -> EntryIndex -> InsertEntry -> m EntryRId
insertEntry insertEntry
k k
i i

View File

@ -485,33 +485,6 @@ matchGroupsMaybe q re = case regexec re q of
-- this should never fail as regexec always returns Right -- this should never fail as regexec always returns Right
Left _ -> [] Left _ -> []
-- parseRational :: MonadFail m => (T.Text, Regex) -> T.Text -> m Rational
-- parseRational (pat, re) s = case matchGroupsMaybe s re of
-- [sign, x, ""] -> uncurry (*) <$> readWhole sign x
-- [sign, x, y] -> do
-- d <- readT "decimal" y
-- let p = 10 ^ T.length y
-- (k, w) <- readWhole sign x
-- return $ k * (w + d % p)
-- _ -> msg "malformed decimal"
-- where
-- readT what t = case readMaybe $ T.unpack t of
-- Just d -> return $ fromInteger d
-- _ -> msg $ T.unwords ["could not parse", what, singleQuote t]
-- msg :: MonadFail m => T.Text -> m a
-- msg m =
-- fail $
-- T.unpack $
-- T.unwords [m, "-", keyVals [("pattern", pat), ("query", s)]]
-- readSign x
-- | x == "-" = return (-1)
-- | x == "+" || x == "" = return 1
-- | otherwise = msg $ T.append "invalid sign: " x
-- readWhole sign x = do
-- w <- readT "whole number" x
-- k <- readSign sign
-- return (k, w)
parseDecimal :: MonadFail m => (T.Text, Regex) -> T.Text -> m Decimal parseDecimal :: MonadFail m => (T.Text, Regex) -> T.Text -> m Decimal
parseDecimal (pat, re) s = case matchGroupsMaybe s re of parseDecimal (pat, re) s = case matchGroupsMaybe s re of
[sign, x, ""] -> Decimal 0 . uncurry (*) <$> readWhole sign x [sign, x, ""] -> Decimal 0 . uncurry (*) <$> readWhole sign x

View File

@ -64,7 +64,7 @@ TransactionR sql=transactions
EntrySetR sql=entry_sets EntrySetR sql=entry_sets
transaction TransactionRId transaction TransactionRId
currency CurrencyRId currency CurrencyRId
index Int index EntrySetIndex
rebalance Bool rebalance Bool
deriving Show Eq deriving Show Eq
EntryR sql=entries EntryR sql=entries
@ -72,10 +72,10 @@ EntryR sql=entries
account AccountRId account AccountRId
memo T.Text memo T.Text
value Rational value Rational
index Int index EntryIndex
cachedValue (Maybe Rational) cachedValue (Maybe Rational)
cachedType (Maybe TransferType) cachedType (Maybe TransferType)
cachedLink (Maybe Int) cachedLink (Maybe EntryIndex)
deriving Show Eq deriving Show Eq
TagRelationR sql=tag_relations TagRelationR sql=tag_relations
entry EntryRId entry EntryRId
@ -83,6 +83,12 @@ TagRelationR sql=tag_relations
deriving Show Eq deriving Show Eq
|] |]
newtype EntrySetIndex = EntrySetIndex {unEntrySetIndex :: Int}
deriving newtype (Show, Eq, Ord, Num, Real, Enum, Integral, PersistField, PersistFieldSql)
newtype EntryIndex = EntryIndex {unEntryIndex :: Int}
deriving newtype (Show, Eq, Ord, Num, Real, Enum, Integral, PersistField, PersistFieldSql)
newtype TxDesc = TxDesc {unTxDesc :: T.Text} newtype TxDesc = TxDesc {unTxDesc :: T.Text}
deriving newtype (Show, Eq, Ord, PersistField, PersistFieldSql, FromField) deriving newtype (Show, Eq, Ord, PersistField, PersistFieldSql, FromField)

View File

@ -26,13 +26,6 @@ import Text.Regex.TDFA
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- database cache types -- database cache types
data ConfigHashes = ConfigHashes
{ chIncome :: ![Int]
, chExpense :: ![Int]
, chManual :: ![Int]
, chImport :: ![Int]
}
data DeleteTxs = DeleteTxs data DeleteTxs = DeleteTxs
{ dtTxs :: ![TransactionRId] { dtTxs :: ![TransactionRId]
, dtEntrySets :: ![EntrySetRId] , dtEntrySets :: ![EntrySetRId]
@ -101,7 +94,7 @@ data UpdateEntry i v = UpdateEntry
{ ueID :: !i { ueID :: !i
, ueAcnt :: !AccountRId , ueAcnt :: !AccountRId
, ueValue :: !v , ueValue :: !v
, ueIndex :: !Int , ueIndex :: !EntryIndex
} }
deriving (Show) deriving (Show)

View File

@ -4,7 +4,6 @@ module Internal.Utils
, askDays , askDays
, fromWeekday , fromWeekday
, inDaySpan , inDaySpan
, fmtRational
, fromGregorian' , fromGregorian'
, resolveDaySpan , resolveDaySpan
, resolveDaySpan_ , resolveDaySpan_
@ -306,6 +305,9 @@ valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
dateMatches :: DateMatcher -> Day -> Bool dateMatches :: DateMatcher -> Day -> Bool
dateMatches md = (EQ ==) . compareDate md dateMatches md = (EQ ==) . compareDate md
--------------------------------------------------------------------------------
-- error flow control
liftInner :: Monad m => ExceptT e Identity a -> ExceptT e m a liftInner :: Monad m => ExceptT e Identity a -> ExceptT e m a
liftInner = mapExceptT (return . runIdentity) liftInner = mapExceptT (return . runIdentity)
@ -409,17 +411,6 @@ lookupErr what k m = case M.lookup k m of
Just x -> return x Just x -> return x
_ -> throwError $ InsertException [LookupError what $ tshow k] _ -> throwError $ InsertException [LookupError what $ tshow k]
fmtRational :: Natural -> Rational -> T.Text
fmtRational precision x = T.concat [s, txt n', ".", pad 2 "0" $ txt d']
where
s = if x >= 0 then "" else "-"
x'@(n :% d) = abs x
p = 10 ^ precision
n' = div n d
d' = (\(a :% b) -> div a b) ((x' - fromIntegral n') * p)
txt = T.pack . show
pad i c z = T.append (T.replicate (i - T.length z) c) z
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- error display -- error display