REF use newtype for indices
This commit is contained in:
parent
901882b79f
commit
ad5e4a0748
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in New Issue