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
|
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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue