FIX don't hash budget components (since they are interdependent)

lib/Internal/Database/Ops.hs

@@ -95,14 +95,11 @@ hashConfig
   Config_
     { budget = bs
     , statements = ss
-    } =
+    } = (hash <$> bs) ++ (hash <$> ms) ++ (hash <$> ps)
-    concatMap budgetHashes bs ++ (hash <$> ms) ++ (hash <$> ps)
     where
       (ms, ps) = partitionEithers $ fmap go ss
       go (StmtManual x) = Left x
       go (StmtImport x) = Right x
-      budgetHashes Budget {transfers = xs, income = is} =
-        (hash <$> xs) ++ (hash <$> is)
 
 setDiff :: Eq a => [a] -> [a] -> ([a], [a])
 -- setDiff = setDiff' (==)

lib/Internal/Insert.hs

@@ -119,9 +119,10 @@ withDates dp f = do
 -- 5. insert all transactions
 
 insertBudget :: MonadFinance m => Budget -> SqlPersistT m [InsertError]
-insertBudget Budget {budgetLabel = name, income = is, transfers = es, shadowTransfers = ss} = do
+insertBudget b@(Budget {budgetLabel = name, income = is, transfers = es, shadowTransfers = ss}) =
-  res1 <- mapM (insertIncome name) is
+  whenHash CTBudget b [] $ \key -> do
-  res2 <- expandTransfers name es
+    res1 <- mapM (insertIncome key name) is
+    res2 <- expandTransfers key name es
     unlessLefts (concatEithers2 (fmap concat $ concatEithersL res1) res2 (++)) $
       \txs -> do
         unlessLefts (addShadowTransfers ss txs) $ \shadow -> do
@@ -173,13 +174,15 @@ shadowMatches ShadowMatch {smFrom, smTo, smDate, smVal} tx = do
       (if asInclude then id else not) $ x `elem` asList
 
 balanceTransfers :: [BudgetTxType] -> [BudgetTx]
-balanceTransfers ts = snd $ L.mapAccumR go initBals $ L.sortOn (btWhen . bttTx) ts
+balanceTransfers ts =
+  snd $ L.mapAccumR go initBals $ reverse $ L.sortOn (btWhen . bttTx) ts
   where
     initBals =
       M.fromList $
         fmap (,0) $
           L.nub $
-            (fmap (btTo . bttTx) ts ++ fmap (btTo . bttTx) ts)
+            fmap (btTo . bttTx) ts
+              ++ fmap (btFrom . bttTx) ts
     updateBal x = M.update (Just . (+ x))
     lookupBal = M.findWithDefault (error "this should not happen")
     go bals btt =
@@ -197,7 +200,7 @@ balanceTransfers ts = snd $ L.mapAccumR go initBals $ L.sortOn (btWhen . bttTx)
     amtToMove bal Target x = x - bal
 
 data BudgetMeta = BudgetMeta
-  { bmCommit :: !(Key CommitR)
+  { bmCommit :: !CommitRId
   , bmCur :: !BudgetCurrency
   , bmName :: !T.Text
   }
@@ -216,12 +219,13 @@ data BudgetTxType = BudgetTxType
   , bttTx :: !BudgetTx
   }
 
-insertIncome :: MonadFinance m => T.Text -> Income -> SqlPersistT m (EitherErrs [BudgetTxType])
+insertIncome :: MonadFinance m => CommitRId -> T.Text -> Income -> SqlPersistT m (EitherErrs [BudgetTxType])
 insertIncome
+  key
   name
-  i@Income {incWhen, incCurrency, incFrom, incPretax, incPosttax, incTaxes, incToBal} =
+  i@Income {incWhen, incCurrency, incFrom, incPretax, incPosttax, incTaxes, incToBal} = do
-    whenHash CTIncome i (Right []) $ \c -> do
+    -- whenHash CTIncome i (Right []) $ \c -> do
-      let meta = BudgetMeta c (NoX incCurrency) name
+    let meta = BudgetMeta key (NoX incCurrency) name
     let balRes = balanceIncome i
     fromRes <- lift $ checkAcntType IncomeT $ taAcnt incFrom
     case concatEither2 balRes fromRes (,) of
@@ -325,16 +329,17 @@ sumTaxes = sum . fmap (dec2Rat . taxValue)
 
 expandTransfers
   :: MonadFinance m
-  => T.Text
+  => CommitRId
+  -> T.Text
   -> [Transfer]
   -> SqlPersistT m (EitherErrs [BudgetTxType])
-expandTransfers name ts = do
+expandTransfers key name ts = do
-  txs <- mapM (expandTransfer name) ts
+  txs <- mapM (expandTransfer key name) ts
   return $ L.sortOn (btWhen . bttTx) . concat <$> concatEithersL txs
 
-expandTransfer :: MonadFinance m => T.Text -> Transfer -> SqlPersistT m (EitherErrs [BudgetTxType])
+expandTransfer :: MonadFinance m => CommitRId -> T.Text -> Transfer -> SqlPersistT m (EitherErrs [BudgetTxType])
-expandTransfer name t@Transfer {transAmounts, transTo, transCurrency, transFrom} =
+expandTransfer key name Transfer {transAmounts, transTo, transCurrency, transFrom} =
-  whenHash CTExpense t (Right []) $ \key ->
+  -- whenHash CTExpense t (Right []) $ \key ->
   fmap (fmap concat . concatEithersL) $
     forM transAmounts $ \(TimeAmount (Amount desc v) atype pat) -> do
       withDates pat $ \day ->

lib/Internal/Types.hs

@@ -524,7 +524,7 @@ data ConfigHashes = ConfigHashes
   , chImport :: ![Int]
   }
 
-data ConfigType = CTIncome | CTExpense | CTShadow | CTManual | CTImport
+data ConfigType = CTBudget | CTManual | CTImport
   deriving (Eq, Show, Read, Enum)
 
 instance PersistFieldSql ConfigType where

lib/Internal/Utils.hs

@@ -350,7 +350,7 @@ showError other = (: []) $ case other of
   (MatchValPrecisionError d p) ->
     T.unwords ["Match denominator", showT d, "must be less than", showT p]
   (LookupError t f) ->
-    T.unwords ["Could not find field", singleQuote f, "when resolving", what]
+    T.unwords ["Could not find field", f, "when resolving", what]
     where
       what = case t of
         SplitIDField st -> T.unwords ["split", idName st, "ID"]