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
:: Precision
-> [UEUnk]
-> [(Int, NonEmpty (EntryRId, EntryR))]
-> [(EntryIndex, NonEmpty (EntryRId, EntryR))]
-> InsertExcept ([(UEUnk, [UELink])], [UE_RO])
zipPaired prec = go ([], [])
where
@ -697,7 +697,7 @@ insertTx c InsertTx {itxDate, itxDescr, itxEntrySets, itxBudget, itxPriority} =
mapM_ (uncurry (go esk)) $ zip [0 ..] ts ++ zip (negate <$> [1 ..]) fs
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
k
i

View File

@ -485,33 +485,6 @@ matchGroupsMaybe q re = case regexec re q of
-- this should never fail as regexec always returns Right
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 (pat, re) s = case matchGroupsMaybe s re of
[sign, x, ""] -> Decimal 0 . uncurry (*) <$> readWhole sign x

View File

@ -64,7 +64,7 @@ TransactionR sql=transactions
EntrySetR sql=entry_sets
transaction TransactionRId
currency CurrencyRId
index Int
index EntrySetIndex
rebalance Bool
deriving Show Eq
EntryR sql=entries
@ -72,10 +72,10 @@ EntryR sql=entries
account AccountRId
memo T.Text
value Rational
index Int
index EntryIndex
cachedValue (Maybe Rational)
cachedType (Maybe TransferType)
cachedLink (Maybe Int)
cachedLink (Maybe EntryIndex)
deriving Show Eq
TagRelationR sql=tag_relations
entry EntryRId
@ -83,6 +83,12 @@ TagRelationR sql=tag_relations
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}
deriving newtype (Show, Eq, Ord, PersistField, PersistFieldSql, FromField)

View File

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

View File

@ -4,7 +4,6 @@ module Internal.Utils
, askDays
, fromWeekday
, inDaySpan
, fmtRational
, fromGregorian'
, resolveDaySpan
, resolveDaySpan_
@ -306,6 +305,9 @@ valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
dateMatches :: DateMatcher -> Day -> Bool
dateMatches md = (EQ ==) . compareDate md
--------------------------------------------------------------------------------
-- error flow control
liftInner :: Monad m => ExceptT e Identity a -> ExceptT e m a
liftInner = mapExceptT (return . runIdentity)
@ -409,17 +411,6 @@ lookupErr what k m = case M.lookup k m of
Just x -> return x
_ -> 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