REF use newtypes for budget and tx desc

lib/Internal/Budget.hs

@@ -78,7 +78,7 @@ sortAllo a@Allocation {alloAmts = as} = do
 readIncome
   :: (MonadInsertError m, MonadFinance m)
   => CommitR
-  -> T.Text
+  -> BudgetName
   -> IntAllocations
   -> DaySpan
   -> Income
@@ -154,7 +154,7 @@ readIncome
             , txDate = day
             , txPrimary = Left primary
             , txOther = []
-            , txDescr = ""
+            , txDescr = TxDesc ""
             , txBudget = name
             , txPriority = incPriority
             }

lib/Internal/Database.hs

@@ -298,7 +298,7 @@ currencyMap =
     . fmap
       ( \e ->
           ( currencyRSymbol $ entityVal e
-          , CurrencyPrec (entityKey e) $ fromIntegral $ currencyRPrecision $ entityVal e
+          , CurrencyPrec (entityKey e) $ currencyRPrecision $ entityVal e
           )
       )
 
@@ -517,7 +517,7 @@ readUpdates hashes = do
                   , utToRO = toRO
                   , utFromUnk = fromUnk
                   , utToUnk = toUnk
-                  , utTotalValue = realFracToDecimal prec' tot
+                  , utTotalValue = realFracToDecimal' prec' tot
                   , utBudget = E.unValue name
                   , utPriority = E.unValue pri
                   }
@@ -656,7 +656,7 @@ splitDeferredValue prec p = do
 readDeferredValue :: Precision -> (EntryRId, EntryR) -> InsertExcept (Either UEBlank (Either UE_RO UEUnk))
 readDeferredValue prec (k, e) = case (entryRCachedValue e, entryRCachedType e) of
   (Nothing, Just TFixed) -> return $ Right $ Left $ makeRoUE prec e
-  (Just v, Just TBalance) -> go $ fmap EVBalance $ makeUE k e $ realFracToDecimal prec v
+  (Just v, Just TBalance) -> go $ fmap EVBalance $ makeUE k e $ realFracToDecimal' prec v
   (Just v, Just TPercent) -> go $ fmap EVPercent $ makeUE k e $ fromRational v
   (Nothing, Nothing) -> return $ Left $ makeUnkUE k e
   _ -> throwError $ InsertException undefined
@@ -667,7 +667,7 @@ makeUE :: i -> EntryR -> v -> UpdateEntry i v
 makeUE k e v = UpdateEntry k (entryRAccount e) v (entryRIndex e)
 
 makeRoUE :: Precision -> EntryR -> UpdateEntry () StaticValue
-makeRoUE prec e = makeUE () e $ StaticValue (realFracToDecimal prec $ entryRValue e)
+makeRoUE prec e = makeUE () e $ StaticValue (realFracToDecimal' prec $ entryRValue e)
 
 makeUnkUE :: EntryRId -> EntryR -> UpdateEntry EntryRId ()
 makeUnkUE k e = makeUE k e ()

lib/Internal/History.hs

@@ -284,7 +284,7 @@ matches
       val = valMatches spVal $ toRational 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
+      desc = maybe (return True) (matchMaybe (unTxDesc trDesc) . snd) spDesc
       convert tg = MatchPass <$> toTx (fromIntegral spPriority) tg r
 
 toTx :: MonadFinance m => Int -> TxGetter -> TxRecord -> InsertExceptT m (Tx ())
@@ -539,5 +539,5 @@ parseDecimal (pat, re) s = case matchGroupsMaybe s re of
       k <- readSign sign
       return (k, w)
 
-historyName :: T.Text
-historyName = "history"
+historyName :: BudgetName
+historyName = BudgetName "history"

lib/Internal/Types/Database.hs

@@ -7,6 +7,7 @@
 -- | Types corresponding to the database model
 module Internal.Types.Database where
 
+import Data.Csv (FromField)
 import Database.Persist.Sql hiding (Desc, In, Statement)
 import Database.Persist.TH
 import Internal.Types.Dhall
@@ -56,8 +57,8 @@ AccountPathR sql=account_paths
 TransactionR sql=transactions
     commit CommitRId 
     date Day
-    description T.Text
-    budgetName T.Text
+    description TxDesc
+    budgetName BudgetName
     priority Int
     deriving Show Eq
 EntrySetR sql=entry_sets
@@ -82,8 +83,11 @@ TagRelationR sql=tag_relations
     deriving Show Eq
 |]
 
+newtype TxDesc = TxDesc {unTxDesc :: T.Text}
+  deriving newtype (Show, Eq, Ord, PersistField, PersistFieldSql, FromField)
+
 newtype Precision = Precision {unPrecision :: Word8}
-  deriving newtype (Eq, Ord, Num, Show, PersistField, PersistFieldSql)
+  deriving newtype (Eq, Ord, Num, Show, Real, Enum, Integral, PersistField, PersistFieldSql)
 
 type DaySpan = (Day, Int)
 

lib/Internal/Types/Dhall.hs

@@ -187,8 +187,11 @@ deriving instance Generic PairedTransfer
 
 deriving instance FromDhall PairedTransfer
 
+newtype BudgetName = BudgetName {unBudgetName :: T.Text}
+  deriving newtype (Show, Eq, Ord, Hashable, FromDhall, PersistField, PersistFieldSql)
+
 data Budget = Budget
-  { bgtLabel :: Text
+  { bgtLabel :: BudgetName
   , bgtIncomes :: [Income]
   , bgtPretax :: [MultiAllocation PretaxValue]
   , bgtTax :: [MultiAllocation TaxValue]

lib/Internal/Types/Main.hs

@@ -93,7 +93,7 @@ data ReadEntry = ReadEntry
   , reValue :: !Decimal
   , reDate :: !Day
   , rePriority :: !Int
-  , reBudget :: !T.Text
+  , reBudget :: !BudgetName
   }
   deriving (Show)
 
@@ -137,7 +137,7 @@ data UpdateEntrySet f t = UpdateEntrySet
   , utCurrency :: !CurrencyRId
   , utDate :: !Day
   , utTotalValue :: !t
-  , utBudget :: !T.Text
+  , utBudget :: !BudgetName
   , utPriority :: !Int
   }
   deriving (Show)
@@ -164,7 +164,7 @@ askDBState = asks
 data TxRecord = TxRecord
   { trDate :: !Day
   , trAmount :: !Decimal
-  , trDesc :: !T.Text
+  , trDesc :: !TxDesc
   , trOther :: !(M.Map T.Text T.Text)
   , trFile :: !FilePath
   }
@@ -209,13 +209,13 @@ data TxCommit = HistoryCommit CommitR | BudgetCommit CommitR T.Text
   deriving (Eq, Ord, Show)
 
 data Tx k = Tx
-  { txDescr :: !T.Text
+  { txDescr :: !TxDesc
   , txDate :: !Day
   , txPriority :: !Int
   , txPrimary :: !(Either PrimaryEntrySet TransferEntrySet)
   , txOther :: ![Either SecondayEntrySet ShadowEntrySet]
   , txCommit :: !k
-  , txBudget :: !T.Text
+  , txBudget :: !BudgetName
   }
   deriving (Generic, Show)
 
@@ -231,12 +231,12 @@ data InsertEntrySet = InsertEntrySet
   }
 
 data InsertTx = InsertTx
-  { itxDescr :: !T.Text
+  { itxDescr :: !TxDesc
   , itxDate :: !Day
   , itxPriority :: !Int
   , itxEntrySets :: !(NonEmpty InsertEntrySet)
   , itxCommit :: !CommitR
-  , itxBudget :: !T.Text
+  , itxBudget :: !BudgetName
   }
   deriving (Generic)
 

lib/Internal/Utils.hs

@@ -520,7 +520,7 @@ tshowx TxRecord {trDate = d, trAmount = v, trDesc = e, trFile = f} =
       [ ("path", T.pack f)
       , ("date", T.pack $ iso8601Show d)
       , ("value", tshow v)
-      , ("description", doubleQuote e)
+      , ("description", doubleQuote $ unTxDesc e)
       ]
 
 showMatch :: MatchRe -> T.Text
@@ -700,7 +700,7 @@ binDate (ToUpdate u) = either go go u
   where
     go UpdateEntrySet {utDate, utPriority} = (utDate, utPriority)
 
-type BCKey = (CurrencyRId, Text)
+type BCKey = (CurrencyRId, BudgetName)
 
 type ABCKey = (AccountRId, BCKey)
 
@@ -835,7 +835,7 @@ updateUnknown k e = do
 
 balancePrimaryEntrySet
   :: (MonadInsertError m, MonadFinance m)
-  => T.Text
+  => BudgetName
   -> PrimaryEntrySet
   -> StateT EntryBals m InsertEntrySet
 balancePrimaryEntrySet
@@ -860,7 +860,7 @@ balancePrimaryEntrySet
 
 balanceSecondaryEntrySet
   :: (MonadInsertError m, MonadFinance m)
-  => T.Text
+  => BudgetName
   -> SecondayEntrySet
   -> StateT EntryBals m InsertEntrySet
 balanceSecondaryEntrySet
@@ -992,7 +992,7 @@ findBalance k e = do
 expandTransfers
   :: (MonadInsertError m, MonadFinance m)
   => CommitR
-  -> T.Text
+  -> BudgetName
   -> DaySpan
   -> [PairedTransfer]
   -> m [Tx CommitR]
@@ -1001,7 +1001,7 @@ expandTransfers tc name bounds = fmap concat . mapErrors (expandTransfer tc name
 expandTransfer
   :: (MonadInsertError m, MonadFinance m)
   => CommitR
-  -> T.Text
+  -> BudgetName
   -> DaySpan
   -> PairedTransfer
   -> m [Tx CommitR]
@@ -1030,7 +1030,7 @@ expandTransfer tc name bounds Transfer {transAmounts, transTo, transCurrency, tr
               , txDate = day
               , txPrimary = Right $ entryPair transFrom transTo (cpID cp) desc () v''
               , txOther = []
-              , txDescr = desc
+              , txDescr = TxDesc desc
               , txBudget = name
               , txPriority = fromIntegral pri
               }