REF rearrange stuff

app/Main.hs

@@ -180,7 +180,6 @@ runSync c = do
         hSs' <- mapErrorsIO (readHistStmt root) hSs
         hTs' <- liftIOExceptT $ mapErrors readHistTransfer hTs
         bTs <- liftIOExceptT $ mapErrors readBudget $ budget config
-        -- lift $ print hTs'
         return $ second concat $ partitionEithers $ hSs' ++ hTs' ++ bTs
 
     -- Update the DB.

lib/Internal/History.hs

@@ -8,6 +8,7 @@ where
 import Control.Monad.Except
 import Data.Csv
 import Data.Foldable
+import GHC.Real
 import Internal.Database
 import Internal.Types.Main
 import Internal.Utils
@@ -19,6 +20,8 @@ import qualified RIO.Map as M
 import qualified RIO.Text as T
 import RIO.Time
 import qualified RIO.Vector as V
+import Text.Regex.TDFA hiding (matchAll)
+import Text.Regex.TDFA.Text
 
 -- NOTE keep statement and transfer readers separate because the former needs
 -- the IO monad, and thus will throw IO errors rather than using the ExceptT
@@ -261,3 +264,241 @@ matchNonDates ms = go ([], [], initZipper ms)
             MatchSkip -> (Nothing : matched, unmatched)
             MatchFail -> (matched, r : unmatched)
        in go (m, u, resetZipper z') rs
+
+matches :: MonadFinance m => MatchRe -> TxRecord -> InsertExceptT m (MatchRes (Tx ()))
+matches
+  StatementParser {spTx, spOther, spVal, spDate, spDesc}
+  r@TxRecord {trDate, trAmount, trDesc, trOther} = do
+    res <- liftInner $
+      combineError3 val other desc $
+        \x y z -> x && y && z && date
+    if res
+      then maybe (return MatchSkip) convert spTx
+      else return MatchFail
+    where
+      val = valMatches spVal trAmount
+      date = maybe True (`dateMatches` trDate) spDate
+      other = foldM (\a o -> (a &&) <$> otherMatches trOther o) True spOther
+      desc = maybe (return True) (matchMaybe trDesc . snd) spDesc
+      convert tg = MatchPass <$> toTx tg r
+
+toTx :: MonadFinance m => TxGetter -> TxRecord -> InsertExceptT m (Tx ())
+toTx
+  TxGetter
+    { tgFrom
+    , tgTo
+    , tgCurrency
+    , tgOtherEntries
+    , tgScale
+    }
+  r@TxRecord {trAmount, trDate, trDesc} = do
+    combineError curRes subRes $ \(cur, f, t) ss ->
+      Tx
+        { txDate = trDate
+        , txDescr = trDesc
+        , txCommit = ()
+        , txPrimary =
+            Left $
+              EntrySet
+                { esTotalValue = roundPrecisionCur cur $ tgScale * fromRational trAmount
+                , esCurrency = cur
+                , esFrom = f
+                , esTo = t
+                }
+        , txOther = fmap Left ss
+        }
+    where
+      curRes = do
+        m <- askDBState kmCurrency
+        cur <- liftInner $ resolveCurrency m r tgCurrency
+        let fromRes = liftInner $ resolveHalfEntry resolveFromValue cur r () tgFrom
+        let toRes = liftInner $ resolveHalfEntry resolveToValue cur r () tgTo
+        combineError fromRes toRes (cur,,)
+      subRes = mapErrors (resolveSubGetter r) tgOtherEntries
+
+resolveSubGetter
+  :: MonadFinance m
+  => TxRecord
+  -> TxSubGetter
+  -> InsertExceptT m SecondayEntrySet
+resolveSubGetter r TxSubGetter {tsgFrom, tsgTo, tsgValue, tsgCurrency} = do
+  m <- askDBState kmCurrency
+  cur <- liftInner $ resolveCurrency m r tsgCurrency
+  let toRes = resolveHalfEntry resolveToValue cur r () tsgTo
+  let valRes = liftInner $ fmap (roundPrecisionCur cur) <$> resolveValue r tsgValue
+  liftInner $ combineErrorM toRes valRes $ \t v -> do
+    f <- resolveHalfEntry resolveFromValue cur r v tsgFrom
+    return $
+      EntrySet
+        { esTotalValue = ()
+        , esCurrency = cur
+        , esFrom = f
+        , esTo = t
+        }
+
+resolveHalfEntry
+  :: Traversable f
+  => (TxRecord -> n -> InsertExcept (f Double))
+  -> CurrencyPrec
+  -> TxRecord
+  -> v
+  -> TxHalfGetter (EntryGetter n)
+  -> InsertExcept (HalfEntrySet v (f Rational))
+resolveHalfEntry f cur r v TxHalfGetter {thgAcnt, thgComment, thgTags, thgEntries} =
+  combineError acntRes esRes $ \a es ->
+    HalfEntrySet
+      { hesPrimary =
+          Entry
+            { eAcnt = a
+            , eValue = v
+            , eComment = thgComment
+            , eTags = thgTags
+            }
+      , hesOther = es
+      }
+  where
+    acntRes = resolveAcnt r thgAcnt
+    esRes = mapErrors (resolveEntry f cur r) thgEntries
+
+otherMatches :: M.Map T.Text T.Text -> FieldMatcherRe -> InsertExcept Bool
+otherMatches dict m = case m of
+  Val (Field n mv) -> valMatches mv =<< (readRational =<< lookup_ MatchNumeric n)
+  Desc (Field n (_, md)) -> (`matchMaybe` md) =<< lookup_ MatchText n
+  where
+    lookup_ t n = lookupErr (MatchField t) n dict
+
+resolveEntry
+  :: Traversable f
+  => (TxRecord -> n -> InsertExcept (f Double))
+  -> CurrencyPrec
+  -> TxRecord
+  -> EntryGetter n
+  -> InsertExcept (Entry AcntID (f Rational) TagID)
+resolveEntry f cur r s@Entry {eAcnt, eValue} = do
+  combineError acntRes valRes $ \a v ->
+    s {eAcnt = a, eValue = roundPrecisionCur cur <$> v}
+  where
+    acntRes = resolveAcnt r eAcnt
+    valRes = f r eValue
+
+resolveFromValue :: TxRecord -> EntryNumGetter -> InsertExcept (EntryValue Double)
+resolveFromValue = resolveValue
+
+resolveToValue :: TxRecord -> LinkedEntryNumGetter -> InsertExcept (LinkDeferred Double)
+resolveToValue _ (Linked l) = return $ LinkIndex l
+resolveToValue r (Getter g) = LinkDeferred <$> resolveValue r g
+
+resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept (EntryValue Double)
+resolveValue TxRecord {trOther, trAmount} s = case s of
+  (LookupN t) -> EntryValue TFixed <$> (readDouble =<< lookupErr EntryValField t trOther)
+  (ConstN c) -> return $ EntryValue TFixed c
+  AmountN m -> return $ EntryValue TFixed $ m * fromRational trAmount
+  BalanceN x -> return $ EntryValue TBalance x
+  PercentN x -> return $ EntryValue TPercent x
+
+resolveAcnt :: TxRecord -> EntryAcnt -> InsertExcept T.Text
+resolveAcnt = resolveEntryField AcntField
+
+resolveCurrency :: CurrencyMap -> TxRecord -> EntryCur -> InsertExcept CurrencyPrec
+resolveCurrency m r c = do
+  i <- resolveEntryField CurField r c
+  case M.lookup i m of
+    Just k -> return k
+    -- TODO this should be its own error (I think)
+    Nothing -> throwError $ InsertException [LookupError (EntryIDField CurField) undefined]
+
+resolveEntryField :: EntryIDType -> TxRecord -> EntryAcnt -> InsertExcept T.Text
+resolveEntryField t TxRecord {trOther = o} s = case s of
+  ConstT p -> return p
+  LookupT f -> lookup_ f o
+  MapT (Field f m) -> do
+    k <- lookup_ f o
+    lookup_ k m
+  Map2T (Field (f1, f2) m) -> do
+    (k1, k2) <- combineError (lookup_ f1 o) (lookup_ f2 o) (,)
+    lookup_ (k1, k2) m
+  where
+    lookup_ :: (Ord k, Show k) => k -> M.Map k v -> InsertExcept v
+    lookup_ = lookupErr (EntryIDField t)
+
+readDouble :: T.Text -> InsertExcept Double
+readDouble s = case readMaybe $ T.unpack s of
+  Just x -> return x
+  Nothing -> throwError $ InsertException [ConversionError s]
+
+readRational :: T.Text -> InsertExcept Rational
+readRational s = case T.split (== '.') s of
+  [x] -> maybe err (return . fromInteger) $ readT x
+  [x, y] -> case (readT x, readT y) of
+    (Just x', Just y') ->
+      let p = 10 ^ T.length y
+          k = if x' >= 0 then 1 else -1
+       in return $ fromInteger x' + k * y' % p
+    _ -> err
+  _ -> err
+  where
+    readT = readMaybe . T.unpack
+    err = throwError $ InsertException [ConversionError s]
+
+compileOptions :: TxOpts T.Text -> InsertExcept TxOptsRe
+compileOptions o@TxOpts {toAmountFmt = pat} = do
+  re <- compileRegex True pat
+  return $ o {toAmountFmt = re}
+
+compileMatch :: StatementParser T.Text -> InsertExcept MatchRe
+compileMatch m@StatementParser {spDesc, spOther} = do
+  combineError dres ores $ \d os -> m {spDesc = d, spOther = os}
+  where
+    go = compileRegex False
+    dres = mapM go spDesc
+    ores = combineErrors $ fmap (mapM go) spOther
+
+compileRegex :: Bool -> T.Text -> InsertExcept (Text, Regex)
+compileRegex groups pat = case res of
+  Right re -> return (pat, re)
+  Left _ -> throwError $ InsertException [RegexError pat]
+  where
+    res =
+      compile
+        (blankCompOpt {newSyntax = True})
+        (blankExecOpt {captureGroups = groups})
+        pat
+
+matchMaybe :: T.Text -> Regex -> InsertExcept Bool
+matchMaybe q re = case execute re q of
+  Right res -> return $ isJust res
+  Left _ -> throwError $ InsertException [RegexError "this should not happen"]
+
+matchGroupsMaybe :: T.Text -> Regex -> [T.Text]
+matchGroupsMaybe q re = case regexec re q of
+  Right Nothing -> []
+  Right (Just (_, _, _, xs)) -> xs
+  -- 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)

lib/Internal/Types/Database.hs

@@ -64,6 +64,7 @@ EntryR sql=entries
 TagRelationR sql=tag_relations
     entry EntryRId OnDeleteCascade
     tag TagRId OnDeleteCascade
+    deriving Show Eq
 BudgetLabelR sql=budget_labels
     entry EntryRId OnDeleteCascade
     budgetName T.Text

lib/Internal/Types/Main.hs

@@ -76,6 +76,7 @@ data ReadEntry = ReadEntry
   , reValue :: !Rational
   , reDate :: !Day
   }
+  deriving (Show)
 
 data UpdateEntry i v = UpdateEntry
   { ueID :: !i
@@ -83,21 +84,22 @@ data UpdateEntry i v = UpdateEntry
   , ueValue :: !v
   , ueIndex :: !Int
   }
+  deriving (Show)
 
 data CurrencyRound = CurrencyRound CurID Natural
 
 deriving instance Functor (UpdateEntry i)
 
 newtype LinkScale = LinkScale {unLinkScale :: Rational}
-  deriving newtype (Num)
+  deriving newtype (Num, Show)
 
 -- newtype BalanceTarget = BalanceTarget {unBalanceTarget :: Rational}
 --   deriving newtype (Num)
 
 newtype StaticValue = StaticValue {unStaticValue :: Rational}
-  deriving newtype (Num)
+  deriving newtype (Num, Show)
 
-data EntryValueUnk = EVBalance Rational | EVPercent Rational
+data EntryValueUnk = EVBalance Rational | EVPercent Rational deriving (Show)
 
 type UEUnk = UpdateEntry EntryRId EntryValueUnk
 
@@ -120,6 +122,7 @@ data UpdateEntrySet f t = UpdateEntrySet
   , utDate :: !Day
   , utTotalValue :: !t
   }
+  deriving (Show)
 
 type TotalUpdateEntrySet = UpdateEntrySet (UEBlank, [UELink]) Rational
 

lib/Internal/Utils.hs

@@ -5,7 +5,6 @@ module Internal.Utils
   , fromWeekday
   , inDaySpan
   , fmtRational
-  , matches
   , fromGregorian'
   , resolveDaySpan
   , resolveDaySpan_
@@ -28,12 +27,7 @@ module Internal.Utils
   , combineErrorIOM3
   , collectErrorsIO
   , mapErrorsIO
-  , parseRational
   , showError
-  , unlessLeft_
-  , unlessLefts_
-  , unlessLeft
-  , unlessLefts
   , acntPath2Text
   , showT
   , lookupErr
@@ -43,8 +37,6 @@ module Internal.Utils
   , sndOf3
   , thdOf3
   , xGregToDay
-  , compileMatch
-  , compileOptions
   , dateMatches
   , valMatches
   , roundPrecision
@@ -64,6 +56,8 @@ module Internal.Utils
   , expandTransfers
   , expandTransfer
   , entryPair
+  , singleQuote
+  , keyVals
   )
 where
 
@@ -80,8 +74,6 @@ import RIO.State
 import qualified RIO.Text as T
 import RIO.Time
 import qualified RIO.Vector as V
-import Text.Regex.TDFA
-import Text.Regex.TDFA.Text
 
 --------------------------------------------------------------------------------
 -- intervals
@@ -300,101 +292,6 @@ toDaySpan (a, b) = (a, fromIntegral $ diffDays b a - 1)
 --------------------------------------------------------------------------------
 -- matching
 
-matches :: MonadFinance m => MatchRe -> TxRecord -> InsertExceptT m (MatchRes (Tx ()))
-matches
-  StatementParser {spTx, spOther, spVal, spDate, spDesc}
-  r@TxRecord {trDate, trAmount, trDesc, trOther} = do
-    res <- liftInner $
-      combineError3 val other desc $
-        \x y z -> x && y && z && date
-    if res
-      then maybe (return MatchSkip) convert spTx
-      else return MatchFail
-    where
-      val = valMatches spVal trAmount
-      date = maybe True (`dateMatches` trDate) spDate
-      other = foldM (\a o -> (a &&) <$> otherMatches trOther o) True spOther
-      desc = maybe (return True) (matchMaybe trDesc . snd) spDesc
-      convert tg = MatchPass <$> toTx tg r
-
-toTx :: MonadFinance m => TxGetter -> TxRecord -> InsertExceptT m (Tx ())
-toTx
-  TxGetter
-    { tgFrom
-    , tgTo
-    , tgCurrency
-    , tgOtherEntries
-    , tgScale
-    }
-  r@TxRecord {trAmount, trDate, trDesc} = do
-    combineError curRes subRes $ \(cur, f, t) ss ->
-      Tx
-        { txDate = trDate
-        , txDescr = trDesc
-        , txCommit = ()
-        , txPrimary =
-            Left $
-              EntrySet
-                { esTotalValue = roundPrecisionCur cur $ tgScale * fromRational trAmount
-                , esCurrency = cur
-                , esFrom = f
-                , esTo = t
-                }
-        , txOther = fmap Left ss
-        }
-    where
-      curRes = do
-        m <- askDBState kmCurrency
-        cur <- liftInner $ resolveCurrency m r tgCurrency
-        let fromRes = liftInner $ resolveHalfEntry resolveFromValue cur r () tgFrom
-        let toRes = liftInner $ resolveHalfEntry resolveToValue cur r () tgTo
-        combineError fromRes toRes (cur,,)
-      subRes = mapErrors (resolveSubGetter r) tgOtherEntries
-
-resolveSubGetter
-  :: MonadFinance m
-  => TxRecord
-  -> TxSubGetter
-  -> InsertExceptT m SecondayEntrySet
-resolveSubGetter r TxSubGetter {tsgFrom, tsgTo, tsgValue, tsgCurrency} = do
-  m <- askDBState kmCurrency
-  cur <- liftInner $ resolveCurrency m r tsgCurrency
-  let toRes = resolveHalfEntry resolveToValue cur r () tsgTo
-  let valRes = liftInner $ fmap (roundPrecisionCur cur) <$> resolveValue r tsgValue
-  liftInner $ combineErrorM toRes valRes $ \t v -> do
-    f <- resolveHalfEntry resolveFromValue cur r v tsgFrom
-    return $
-      EntrySet
-        { esTotalValue = ()
-        , esCurrency = cur
-        , esFrom = f
-        , esTo = t
-        }
-
-resolveHalfEntry
-  :: Traversable f
-  => (TxRecord -> n -> InsertExcept (f Double))
-  -> CurrencyPrec
-  -> TxRecord
-  -> v
-  -> TxHalfGetter (EntryGetter n)
-  -> InsertExcept (HalfEntrySet v (f Rational))
-resolveHalfEntry f cur r v TxHalfGetter {thgAcnt, thgComment, thgTags, thgEntries} =
-  combineError acntRes esRes $ \a es ->
-    HalfEntrySet
-      { hesPrimary =
-          Entry
-            { eAcnt = a
-            , eValue = v
-            , eComment = thgComment
-            , eTags = thgTags
-            }
-      , hesOther = es
-      }
-  where
-    acntRes = resolveAcnt r thgAcnt
-    esRes = mapErrors (resolveEntry f cur r) thgEntries
-
 valMatches :: ValMatcher -> Rational -> InsertExcept Bool
 valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
   | Just d_ <- vmDen, d_ >= p = throwError $ InsertException [MatchValPrecisionError d_ p]
@@ -412,27 +309,6 @@ valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
 dateMatches :: DateMatcher -> Day -> Bool
 dateMatches md = (EQ ==) . compareDate md
 
-otherMatches :: M.Map T.Text T.Text -> FieldMatcherRe -> InsertExcept Bool
-otherMatches dict m = case m of
-  Val (Field n mv) -> valMatches mv =<< (readRational =<< lookup_ MatchNumeric n)
-  Desc (Field n (_, md)) -> (`matchMaybe` md) =<< lookup_ MatchText n
-  where
-    lookup_ t n = lookupErr (MatchField t) n dict
-
-resolveEntry
-  :: Traversable f
-  => (TxRecord -> n -> InsertExcept (f Double))
-  -> CurrencyPrec
-  -> TxRecord
-  -> EntryGetter n
-  -> InsertExcept (Entry AcntID (f Rational) TagID)
-resolveEntry f cur r s@Entry {eAcnt, eValue} = do
-  combineError acntRes valRes $ \a v ->
-    s {eAcnt = a, eValue = roundPrecisionCur cur <$> v}
-  where
-    acntRes = resolveAcnt r eAcnt
-    valRes = f r eValue
-
 liftInner :: Monad m => ExceptT e Identity a -> ExceptT e m a
 liftInner = mapExceptT (return . runIdentity)
 
@@ -442,9 +318,6 @@ liftExceptT x = runExceptT x >>= either throwError return
 liftExcept :: MonadError e m => Except e a -> m a
 liftExcept = either throwError return . runExcept
 
--- tryError :: MonadError e m => m a -> m (Either e a)
--- tryError action = (Right <$> action) `catchError` (pure . Left)
-
 liftIOExceptT :: MonadIO m => InsertExceptT m a -> m a
 liftIOExceptT = fromEither <=< runExceptT
 
@@ -526,101 +399,11 @@ mapErrorsIO f xs = mapM go $ enumTraversable xs
 collectErrorsIO :: (Traversable t, MonadUnliftIO m) => t (m a) -> m (t a)
 collectErrorsIO = mapErrorsIO id
 
-resolveFromValue :: TxRecord -> EntryNumGetter -> InsertExcept (EntryValue Double)
-resolveFromValue = resolveValue
-
-resolveToValue :: TxRecord -> LinkedEntryNumGetter -> InsertExcept (LinkDeferred Double)
-resolveToValue _ (Linked l) = return $ LinkIndex l
-resolveToValue r (Getter g) = LinkDeferred <$> resolveValue r g
-
-resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept (EntryValue Double)
-resolveValue TxRecord {trOther, trAmount} s = case s of
-  (LookupN t) -> EntryValue TFixed <$> (readDouble =<< lookupErr EntryValField t trOther)
-  (ConstN c) -> return $ EntryValue TFixed c
-  AmountN m -> return $ EntryValue TFixed $ m * fromRational trAmount
-  BalanceN x -> return $ EntryValue TBalance x
-  PercentN x -> return $ EntryValue TPercent x
-
-resolveAcnt :: TxRecord -> EntryAcnt -> InsertExcept T.Text
-resolveAcnt = resolveEntryField AcntField
-
-resolveCurrency :: CurrencyMap -> TxRecord -> EntryCur -> InsertExcept CurrencyPrec
-resolveCurrency m r c = do
-  i <- resolveEntryField CurField r c
-  case M.lookup i m of
-    Just k -> return k
-    -- TODO this should be its own error (I think)
-    Nothing -> throwError $ InsertException [LookupError (EntryIDField CurField) undefined]
-
-resolveEntryField :: EntryIDType -> TxRecord -> EntryAcnt -> InsertExcept T.Text
-resolveEntryField t TxRecord {trOther = o} s = case s of
-  ConstT p -> return p
-  LookupT f -> lookup_ f o
-  MapT (Field f m) -> do
-    k <- lookup_ f o
-    lookup_ k m
-  Map2T (Field (f1, f2) m) -> do
-    (k1, k2) <- combineError (lookup_ f1 o) (lookup_ f2 o) (,)
-    lookup_ (k1, k2) m
-  where
-    lookup_ :: (Ord k, Show k) => k -> M.Map k v -> InsertExcept v
-    lookup_ = lookupErr (EntryIDField t)
-
 lookupErr :: (Ord k, Show k) => LookupSuberr -> k -> M.Map k v -> InsertExcept v
 lookupErr what k m = case M.lookup k m of
   Just x -> return x
   _ -> throwError $ InsertException [LookupError what $ showT k]
 
-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)
-
-readDouble :: T.Text -> InsertExcept Double
-readDouble s = case readMaybe $ T.unpack s of
-  Just x -> return x
-  Nothing -> throwError $ InsertException [ConversionError s]
-
-readRational :: T.Text -> InsertExcept Rational
-readRational s = case T.split (== '.') s of
-  [x] -> maybe err (return . fromInteger) $ readT x
-  [x, y] -> case (readT x, readT y) of
-    (Just x', Just y') ->
-      let p = 10 ^ T.length y
-          k = if x' >= 0 then 1 else -1
-       in return $ fromInteger x' + k * y' % p
-    _ -> err
-  _ -> err
-  where
-    readT = readMaybe . T.unpack
-    err = throwError $ InsertException [ConversionError s]
-
--- TODO smells like a lens
--- mapTxSplits :: (a -> b) -> Tx a -> Tx b
--- mapTxSplits f t@Tx {txSplits = ss} = t {txSplits = fmap f ss}
-
 fmtRational :: Natural -> Rational -> T.Text
 fmtRational precision x = T.concat [s, txt n', ".", pad 2 "0" $ txt d']
   where
@@ -834,87 +617,9 @@ keyVals = T.intercalate "; " . fmap (uncurry keyVal)
 showT :: Show a => a -> T.Text
 showT = T.pack . show
 
---------------------------------------------------------------------------------
--- pure error processing
-
--- concatEither2 :: Either x a -> Either x b -> (a -> b -> c) -> Either [x] c
--- concatEither2 a b fun = case (a, b) of
---   (Right a_, Right b_) -> Right $ fun a_ b_
---   _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b]
-
--- concatEither2M :: Monad m => Either x a -> Either x b -> (a -> b -> m c) -> m (Either [x] c)
--- concatEither2M a b fun = case (a, b) of
---   (Right a_, Right b_) -> Right <$> fun a_ b_
---   _ -> return $ Left $ catMaybes [leftToMaybe a, leftToMaybe b]
-
--- concatEither3 :: Either x a -> Either x b -> Either x c -> (a -> b -> c -> d) -> Either [x] d
--- concatEither3 a b c fun = case (a, b, c) of
---   (Right a_, Right b_, Right c_) -> Right $ fun a_ b_ c_
---   _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b, leftToMaybe c]
-
--- concatEithers2 :: Either [x] a -> Either [x] b -> (a -> b -> c) -> Either [x] c
--- concatEithers2 a b = merge . concatEither2 a b
-
--- concatEithers2M
---   :: Monad m
---   => Either [x] a
---   -> Either [x] b
---   -> (a -> b -> m c)
---   -> m (Either [x] c)
--- concatEithers2M a b = fmap merge . concatEither2M a b
-
--- concatEithers3
---   :: Either [x] a
---   -> Either [x] b
---   -> Either [x] c
---   -> (a -> b -> c -> d)
---   -> Either [x] d
--- concatEithers3 a b c = merge . concatEither3 a b c
-
--- concatEitherL :: [Either x a] -> Either [x] [a]
--- concatEitherL as = case partitionEithers as of
---   ([], bs) -> Right bs
---   (es, _) -> Left es
-
--- concatEithersL :: [Either [x] a] -> Either [x] [a]
--- concatEithersL = merge . concatEitherL
-
--- leftToMaybe :: Either a b -> Maybe a
--- leftToMaybe (Left a) = Just a
--- leftToMaybe _ = Nothing
-
-unlessLeft :: (Monad m, MonadPlus n) => Either a b -> (b -> m (n a)) -> m (n a)
-unlessLeft (Left es) _ = return (return es)
-unlessLeft (Right rs) f = f rs
-
-unlessLefts :: (Monad m) => Either (n a) b -> (b -> m (n a)) -> m (n a)
-unlessLefts (Left es) _ = return es
-unlessLefts (Right rs) f = f rs
-
-unlessLeft_ :: (Monad m, MonadPlus n) => Either a b -> (b -> m ()) -> m (n a)
-unlessLeft_ e f = unlessLeft e (\x -> void (f x) >> return mzero)
-
-unlessLefts_ :: (Monad m, MonadPlus n) => Either (n a) b -> (b -> m ()) -> m (n a)
-unlessLefts_ e f = unlessLefts e (\x -> void (f x) >> return mzero)
-
--- plural :: Either a b -> Either [a] b
--- plural = first (: [])
-
--- merge :: Either [[a]] b -> Either [a] b
--- merge = first concat
-
 --------------------------------------------------------------------------------
 -- random functions
 
--- when bifunctor fails...
--- thrice :: (a -> d) -> (b -> e) -> (c -> f) -> (a, b, c) -> (d, e, f)
--- thrice f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
-
--- groupKey :: Ord c => (a -> c) -> [(a, b)] -> [(a, [b])]
--- groupKey f = fmap go . NE.groupAllWith (f . fst)
---   where
---     go xs@((c, _) :| _) = (c, NE.toList $ fmap snd xs)
-
 groupKey :: Ord c => (a -> c) -> [(a, b)] -> [(a, NonEmpty b)]
 groupKey f = fmap go . NE.groupAllWith (f . fst)
   where
@@ -940,65 +645,6 @@ sndOf3 (_, b, _) = b
 thdOf3 :: (a, b, c) -> c
 thdOf3 (_, _, c) = c
 
--- lpad :: a -> Int -> [a] -> [a]
--- lpad c n s = replicate (n - length s) c ++ s
-
--- rpad :: a -> Int -> [a] -> [a]
--- rpad c n s = s ++ replicate (n - length s) c
-
--- lpadT :: Char -> Int -> T.Text -> T.Text
--- lpadT c n s = T.append (T.replicate (n - T.length s) (T.singleton c)) s
-
--- TODO this regular expression appears to be compiled each time, which is
--- super slow
--- NOTE: see https://github.com/haskell-hvr/regex-tdfa/issues/9 - performance
--- is likely not going to be optimal for text
--- matchMaybe :: T.Text -> T.Text -> EitherErr Bool
--- matchMaybe q pat = case compres of
---   Right re -> case execute re q of
---     Right res -> Right $ isJust res
---     Left _ -> Left $ RegexError "this should not happen"
---   Left _ -> Left $ RegexError pat
---   where
---     -- these options barely do anything in terms of performance
---     compres = compile (blankCompOpt {newSyntax = True}) (blankExecOpt {captureGroups = False}) pat
-
-compileOptions :: TxOpts T.Text -> InsertExcept TxOptsRe
-compileOptions o@TxOpts {toAmountFmt = pat} = do
-  re <- compileRegex True pat
-  return $ o {toAmountFmt = re}
-
-compileMatch :: StatementParser T.Text -> InsertExcept MatchRe
-compileMatch m@StatementParser {spDesc, spOther} = do
-  combineError dres ores $ \d os -> m {spDesc = d, spOther = os}
-  where
-    go = compileRegex False
-    dres = mapM go spDesc
-    ores = combineErrors $ fmap (mapM go) spOther
-
-compileRegex :: Bool -> T.Text -> InsertExcept (Text, Regex)
-compileRegex groups pat = case res of
-  Right re -> return (pat, re)
-  Left _ -> throwError $ InsertException [RegexError pat]
-  where
-    res =
-      compile
-        (blankCompOpt {newSyntax = True})
-        (blankExecOpt {captureGroups = groups})
-        pat
-
-matchMaybe :: T.Text -> Regex -> InsertExcept Bool
-matchMaybe q re = case execute re q of
-  Right res -> return $ isJust res
-  Left _ -> throwError $ InsertException [RegexError "this should not happen"]
-
-matchGroupsMaybe :: T.Text -> Regex -> [T.Text]
-matchGroupsMaybe q re = case regexec re q of
-  Right Nothing -> []
-  Right (Just (_, _, _, xs)) -> xs
-  -- this should never fail as regexec always returns Right
-  Left _ -> []
-
 lookupAccount :: (MonadInsertError m, MonadFinance m) => AcntID -> m (AccountRId, AcntSign, AcntType)
 lookupAccount = lookupFinance AcntField kmAccount
 
@@ -1339,7 +985,7 @@ balanceLinked from curID precision acntID lg = case lg of
       Nothing -> throwError undefined
   (LinkDeferred d) -> liftInnerS $ balanceDeferred curID acntID d
   where
-    go s = roundPrecision precision . (* s) . fromRational
+    go s = negate . roundPrecision precision . (* s) . fromRational
 
 balanceDeferred
   :: CurrencyRId