From ad5e4a07486c9e4edc95cf3f1af419fa3c9fa282 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 16 Jul 2023 12:15:39 -0400
Subject: [PATCH] REF use newtype for indices

---
 lib/Internal/Database.hs       |  4 ++--
 lib/Internal/History.hs        | 27 ---------------------------
 lib/Internal/Types/Database.hs | 12 +++++++++---
 lib/Internal/Types/Main.hs     |  9 +--------
 lib/Internal/Utils.hs          | 15 +++------------
 5 files changed, 15 insertions(+), 52 deletions(-)

diff --git a/lib/Internal/Database.hs b/lib/Internal/Database.hs
index 2b4049b..f166c24 100644
--- a/lib/Internal/Database.hs
+++ b/lib/Internal/Database.hs
@@ -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
diff --git a/lib/Internal/History.hs b/lib/Internal/History.hs
index a7522dc..877e973 100644
--- a/lib/Internal/History.hs
+++ b/lib/Internal/History.hs
@@ -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
diff --git a/lib/Internal/Types/Database.hs b/lib/Internal/Types/Database.hs
index 15709a9..f85efbc 100644
--- a/lib/Internal/Types/Database.hs
+++ b/lib/Internal/Types/Database.hs
@@ -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)
 
diff --git a/lib/Internal/Types/Main.hs b/lib/Internal/Types/Main.hs
index 13764cf..1b12fbb 100644
--- a/lib/Internal/Types/Main.hs
+++ b/lib/Internal/Types/Main.hs
@@ -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)
 
diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs
index 5f43653..905f0b8 100644
--- a/lib/Internal/Utils.hs
+++ b/lib/Internal/Utils.hs
@@ -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