WIP use pure errors everywhere

app/Main.hs

@@ -158,13 +158,16 @@ runSync :: MonadUnliftIO m => FilePath -> m ()
 runSync c = do
   config <- readConfig c
   catch (sync_ config) $ \case
-    MatchException -> liftIO $ putStrLn "match error"
+    InsertException _ -> liftIO $ putStrLn "insert error"
-    RegexException -> liftIO $ putStrLn "regex error"
   where
     sync_ config = migrate_ (sqlConfig config) $ do
-      s <- getDBState config
+      res <- getDBState config
-      flip runReaderT (s $ takeDirectory c) $ do
+      case res of
-        insertBudget $ budget config
+        Left e -> throwIO $ InsertException [e]
-        insertStatements config
+        Right s -> flip runReaderT (s $ takeDirectory c) $ do
+          es1 <- insertBudget $ budget config
+          es2 <- insertStatements config
+          let es = es1 ++ es2
+          unless (null es) $ throwIO $ InsertException es
 
 -- showBalances

lib/Internal/Database/Ops.hs

@@ -302,19 +302,28 @@ indexAcntRoot r =
   where
     (ars, aprs, ms) = unzip3 $ uncurry tree2Records <$> flattenAcntRoot r
 
-getDBState :: MonadUnliftIO m => Config -> SqlPersistT m (FilePath -> DBState)
+getDBState
-getDBState c = do
+  :: MonadUnliftIO m
-  am <- updateAccounts $ accounts c
+  => Config
-  cm <- updateCurrencies $ currencies c
+  -> SqlPersistT m (EitherErr (FilePath -> DBState))
-  hs <- updateHashes c
+getDBState c = mapM (uncurry go) intervals
-  -- TODO not sure how I feel about this, probably will change this struct alot
+  where
-  -- in the future so whatever...for now
+    intervals = do
-  return $ \f ->
+      b <- intervalMaybeBounds $ budgetInterval $ global c
-    DBState
+      s <- intervalMaybeBounds $ statementInterval $ global c
-      { kmCurrency = cm
+      return (b, s)
-      , kmAccount = am
+    go budgetInt statementInt = do
-      , kmBudgetInterval = intervalMaybeBounds $ budgetInterval $ global c
+      am <- updateAccounts $ accounts c
-      , kmStatementInterval = intervalMaybeBounds $ statementInterval $ global c
+      cm <- updateCurrencies $ currencies c
-      , kmNewCommits = hs
+      hs <- updateHashes c
-      , kmConfigDir = f
+      -- TODO not sure how I feel about this, probably will change this struct alot
-      }
+      -- in the future so whatever...for now
+      return $ \f ->
+        DBState
+          { kmCurrency = cm
+          , kmAccount = am
+          , kmBudgetInterval = budgetInt
+          , kmStatementInterval = statementInt
+          , kmNewCommits = hs
+          , kmConfigDir = f
+          }

lib/Internal/Insert.hs

@@ -48,24 +48,21 @@ lookupCurrency c = do
 --------------------------------------------------------------------------------
 -- intervals
 
-expandDatePat :: Bounds -> DatePat -> [Day]
+expandDatePat :: Bounds -> DatePat -> EitherErr [Day]
-expandDatePat (a, b) (Cron cp) = filter (cronPatternMatches cp) [a .. b]
+expandDatePat (a, b) (Cron cp) = return $ filter (cronPatternMatches cp) [a .. b]
 expandDatePat i (Mod mp) = expandModPat mp i
 
-expandModPat :: ModPat -> Bounds -> [Day]
+expandModPat :: ModPat -> Bounds -> EitherErr [Day]
 expandModPat
-  ModPat
+  ModPat {mpStart = s, mpBy = b, mpUnit = u, mpRepeats = r}
-    { mpStart = s
+  (lower, upper) = do
-    , mpBy = b
+    start <- maybe (return lower) fromGregorian' s
-    , mpUnit = u
+    return $
-    , mpRepeats = r
+      takeWhile (<= upper) $
-    }
+        (`addFun` start) . (* b')
-  (lower, upper) =
+          <$> maybe id (take . fromIntegral) r [0 ..]
-    takeWhile (<= upper) $
-      (`addFun` start) . (* b')
-        <$> maybe id (take . fromIntegral) r [0 ..]
     where
-      start = maybe lower fromGregorian' s
+      -- start = maybe lower fromGregorian' s
       b' = fromIntegral b
       addFun = case u of
         Day -> addDays
@@ -121,10 +118,11 @@ mdyPatternMatches check x p = case p of
 --------------------------------------------------------------------------------
 -- budget
 
-insertBudget :: MonadUnliftIO m => Budget -> MappingT m ()
+insertBudget :: MonadUnliftIO m => Budget -> MappingT m [InsertError]
 insertBudget Budget {income = is, expenses = es} = do
-  mapM_ insertIncome is
+  es1 <- mapM insertIncome is
-  mapM_ insertExpense es
+  es2 <- mapM insertExpense es
+  return $ catMaybes es1 ++ concat es2
 
 -- TODO this hashes twice (not that it really matters)
 whenHash
@@ -139,7 +137,7 @@ whenHash t o def f = do
   hs <- asks kmNewCommits
   if h `elem` hs then f =<< lift (insert $ CommitR h t) else return def
 
-insertIncome :: MonadUnliftIO m => Income -> MappingT m ()
+insertIncome :: MonadUnliftIO m => Income -> MappingT m (Maybe InsertError)
 insertIncome
   i@Income
     { incCurrency = cur
@@ -147,15 +145,19 @@ insertIncome
     , incAccount = from
     , incTaxes = ts
     } =
-    whenHash CTIncome i () $ \c -> do
+    whenHash CTIncome i Nothing $ \c -> do
       case balanceIncome i of
-        Left m -> liftIO $ print m
+        Left m -> liftIO $ print m >> return Nothing
         Right as -> do
           bounds <- (liftIO . resolveBounds) =<< asks kmBudgetInterval
-          forM_ (expandDatePat bounds dp) $ \day -> do
+          case expandDatePat bounds dp of
-            alloTx <- concat <$> mapM (allocationToTx from day) as
+            Left e -> return $ Just e
-            taxTx <- fmap (,Fixed) <$> mapM (taxToTx from day cur) ts
+            Right days -> do
-            lift $ mapM_ (\(t, b) -> insertTxBucket (Just b) c t) $ alloTx ++ taxTx
+              forM_ days $ \day -> do
+                alloTx <- concat <$> mapM (allocationToTx from day) as
+                taxTx <- fmap (,Fixed) <$> mapM (taxToTx from day cur) ts
+                lift $ mapM_ (\(t, b) -> insertTxBucket (Just b) c t) $ alloTx ++ taxTx
+              return Nothing
 
 balanceIncome :: Income -> Either T.Text [BalAllocation]
 balanceIncome
@@ -234,7 +236,7 @@ transferToTx
 transferToTx day from to cur Amount {amtValue = v, amtDesc = d} =
   txPair day from to cur v d
 
-insertExpense :: MonadUnliftIO m => Expense -> MappingT m ()
+insertExpense :: MonadUnliftIO m => Expense -> MappingT m [InsertError]
 insertExpense
   e@Expense
     { expFrom = from
@@ -243,17 +245,23 @@ insertExpense
     , expBucket = buc
     , expAmounts = as
     } = do
-    whenHash CTExpense e () $ \c -> do
+    whenHash CTExpense e [] $ \key -> catMaybes <$> mapM (go key) as
-      ts <- concat <$> mapM (timeAmountToTx from to cur) as
+    where
-      lift $ mapM_ (insertTxBucket (Just buc) c) ts
+      go key amt = do
+        res <- timeAmountToTx from to cur amt
+        case res of
+          Left err -> return $ Just err
+          Right txs -> do
+            lift $ mapM_ (insertTxBucket (Just buc) key) txs
+            return Nothing
 
 timeAmountToTx
   :: MonadUnliftIO m
   => AcntID
   -> AcntID
-  -> T.Text
+  -> CurID
   -> TimeAmount
-  -> MappingT m [KeyTx]
+  -> MappingT m (EitherErr [KeyTx])
 timeAmountToTx
   from
   to
@@ -267,23 +275,25 @@ timeAmountToTx
         }
     } = do
     bounds <- (liftIO . resolveBounds) =<< asks kmBudgetInterval
-    mapM tx $ expandDatePat bounds dp
+    case expandDatePat bounds dp of
+      Left e -> return $ Left e
+      Right days -> Right <$> mapM tx days
     where
       tx day = txPair day from to cur (dec2Rat v) d
 
 --------------------------------------------------------------------------------
 -- statements
 
-insertStatements :: MonadUnliftIO m => Config -> MappingT m ()
+insertStatements :: MonadUnliftIO m => Config -> MappingT m [InsertError]
-insertStatements conf = do
+insertStatements conf = catMaybes <$> mapM insertStatement (statements conf)
-  es <- catMaybes <$> mapM insertStatement (statements conf)
+
-  unless (null es) $ throwIO $ InsertException es
+-- unless (null es) $ throwIO $ InsertException es
 
 insertStatement :: MonadUnliftIO m => Statement -> MappingT m (Maybe InsertError)
-insertStatement (StmtManual m) = insertManual m >> return Nothing
+insertStatement (StmtManual m) = insertManual m
 insertStatement (StmtImport i) = insertImport i
 
-insertManual :: MonadUnliftIO m => Manual -> MappingT m ()
+insertManual :: MonadUnliftIO m => Manual -> MappingT m (Maybe InsertError)
 insertManual
   m@Manual
     { manualDate = dp
@@ -293,10 +303,14 @@ insertManual
     , manualCurrency = u
     , manualDesc = e
     } = do
-    whenHash CTManual m () $ \c -> do
+    whenHash CTManual m Nothing $ \c -> do
       bounds <- (liftIO . resolveBounds) =<< asks kmStatementInterval
-      ts <- mapM tx $ expandDatePat bounds dp
+      case expandDatePat bounds dp of
-      lift $ mapM_ (insertTx c) ts
+        Left err -> return $ Just err
+        Right days -> do
+          ts <- mapM tx days
+          lift $ mapM_ (insertTx c) ts
+          return Nothing
     where
       tx day = txPair day from to u (dec2Rat v) e
 

lib/Internal/Statement.hs

@@ -100,19 +100,23 @@ resetZipper = initZipper . recoverZipper
 recoverZipper :: Zipped a -> [a]
 recoverZipper (Zipped as bs) = reverse as ++ bs
 
-zipperSlice :: (a -> b -> Ordering) -> b -> Zipped a -> Either (Zipped a) (Unzipped a)
+zipperSlice :: Monad m => (a -> b -> m Ordering) -> b -> Zipped a -> m (Either (Zipped a) (Unzipped a))
 zipperSlice f x = go
   where
-    go z@(Zipped _ []) = Left z
+    go z@(Zipped _ []) = return $ Left z
-    go z@(Zipped bs (a : as)) = case f a x of
+    go z@(Zipped bs (a : as)) = do
-      GT -> go $ Zipped (a : bs) as
+      res <- f a x
-      EQ -> Right $ goEq (Unzipped bs [a] as)
+      case res of
-      LT -> Left z
+        GT -> go $ Zipped (a : bs) as
-    goEq z@(Unzipped _ _ []) = z
+        EQ -> Right <$> goEq (Unzipped bs [a] as)
-    goEq z@(Unzipped bs cs (a : as)) = case f a x of
+        LT -> return $ Left z
-      GT -> goEq $ Unzipped (a : bs) cs as
+    goEq z@(Unzipped _ _ []) = return z
-      EQ -> goEq $ Unzipped bs (a : cs) as
+    goEq z@(Unzipped bs cs (a : as)) = do
-      LT -> z
+      res <- f a x
+      case res of
+        GT -> goEq $ Unzipped (a : bs) cs as
+        EQ -> goEq $ Unzipped bs (a : cs) as
+        LT -> return z
 
 zipperMatch :: Unzipped Match -> TxRecord -> EitherErr (Zipped Match, MatchRes RawTx)
 zipperMatch (Unzipped bs cs as) x = go [] cs
@@ -168,16 +172,18 @@ matchDates ms = go ([], [], initZipper ms)
         , reverse unmatched
         , recoverZipper z
         )
-    go (matched, unmatched, z) (r : rs) = case zipperSlice findDate r z of
+    go (matched, unmatched, z) (r : rs) = do
-      Left zipped -> go (matched, r : unmatched, zipped) rs
+      sliced <- zipperSlice findDate r z
-      Right unzipped -> do
+      case sliced of
-        (z', res) <- zipperMatch unzipped r
+        Left zipped -> go (matched, r : unmatched, zipped) rs
-        let (m, u) = case res of
+        Right unzipped -> do
-              MatchPass p -> (Just p : matched, unmatched)
+          (z', res) <- zipperMatch unzipped r
-              MatchSkip -> (Nothing : matched, unmatched)
+          let (m, u) = case res of
-              MatchFail -> (matched, r : unmatched)
+                MatchPass p -> (Just p : matched, unmatched)
-        go (m, u, z') rs
+                MatchSkip -> (Nothing : matched, unmatched)
-    findDate m r = maybe EQ (`compareDate` trDate r) $ mDate m
+                MatchFail -> (matched, r : unmatched)
+          go (m, u, z') rs
+    findDate m r = maybe (Right EQ) (`compareDate` trDate r) $ mDate m
 
 matchNonDates :: [Match] -> [TxRecord] -> EitherErr ([RawTx], [TxRecord], [Match])
 matchNonDates ms = go ([], [], initZipper ms)

lib/Internal/Types.hs

@@ -508,10 +508,15 @@ data MatchRes a = MatchPass a | MatchFail | MatchSkip
 
 data BalanceType = TooFewSplits | NotOneBlank deriving (Show)
 
+data LookupField = AccountField | CurrencyField | OtherField deriving (Show)
+
+-- data ConversionSubError = Malformed |  deriving (Show)
+
 data InsertError
   = RegexError T.Text
+  | YearError Natural
   | ConversionError T.Text
-  | LookupError T.Text
+  | LookupError LookupField T.Text
   | BalanceError BalanceType CurID [RawSplit]
   | StatementError [TxRecord] [Match]
   deriving (Show)

lib/Internal/Utils.hs

@@ -11,7 +11,6 @@ import RIO
 import qualified RIO.List as L
 import qualified RIO.Map as M
 import qualified RIO.Text as T
-import qualified RIO.Text.Partial as TP
 import RIO.Time
 import Text.Regex.TDFA
 
@@ -20,46 +19,52 @@ 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)
 
 -- TODO get rid of these errors
-gregTup :: Gregorian -> (Integer, Int, Int)
+gregTup :: Gregorian -> EitherErr (Integer, Int, Int)
-gregTup g@Gregorian {..}
+gregTup Gregorian {..}
-  | gYear > 99 = error $ show g ++ ": year must only be two digits"
+  | gYear > 99 = Left $ YearError gYear
   | otherwise =
-      ( fromIntegral gYear + 2000
+      return
-      , fromIntegral gMonth
+        ( fromIntegral gYear + 2000
-      , fromIntegral gDay
+        , fromIntegral gMonth
-      )
+        , fromIntegral gDay
+        )
 
-gregMTup :: GregorianM -> (Integer, Int)
+gregMTup :: GregorianM -> EitherErr (Integer, Int)
-gregMTup g@GregorianM {..}
+gregMTup GregorianM {..}
-  | gmYear > 99 = error $ show g ++ ": year must only be two digits"
+  | gmYear > 99 = Left $ YearError gmYear
   | otherwise =
-      ( fromIntegral gmYear + 2000
+      return
-      , fromIntegral gmMonth
+        ( fromIntegral gmYear + 2000
-      )
+        , fromIntegral gmMonth
+        )
 
 data MDY_ = Y_ Integer | YM_ Integer Int | YMD_ Integer Int Int
 
-fromMatchYMD :: MatchYMD -> MDY_
+fromMatchYMD :: MatchYMD -> EitherErr MDY_
 fromMatchYMD m = case m of
   Y y
-    | y > 99 -> error $ show m ++ ": year must only be two digits"
+    | y > 99 -> Left $ YearError y
-    | otherwise -> Y_ $ fromIntegral y + 2000
+    | otherwise -> Right $ Y_ $ fromIntegral y + 2000
-  YM g -> uncurry YM_ $ gregMTup g
+  YM g -> uncurry YM_ <$> gregMTup g
-  YMD g -> uncurry3 YMD_ $ gregTup g
+  YMD g -> uncurry3 YMD_ <$> gregTup g
 
-compareDate :: MatchDate -> Day -> Ordering
+compareDate :: MatchDate -> Day -> EitherErr Ordering
-compareDate (On md) x = case fromMatchYMD md of
+compareDate (On md) x = do
-  Y_ y' -> compare y y'
+  res <- fromMatchYMD md
-  YM_ y' m' -> compare (y, m) (y', m')
+  return $ case res of
-  YMD_ y' m' d' -> compare (y, m, d) (y', m', d')
+    Y_ y' -> compare y y'
+    YM_ y' m' -> compare (y, m) (y', m')
+    YMD_ y' m' d' -> compare (y, m, d) (y', m', d')
   where
     (y, m, d) = toGregorian x
-compareDate (In md offset) x = case fromMatchYMD md of
+compareDate (In md offset) x = do
-  Y_ y' -> compareRange y' y
+  res <- fromMatchYMD md
-  YM_ y' m' -> compareRange (toMonth y' m') $ toMonth y m
+  return $ case res of
-  YMD_ y' m' d' ->
+    Y_ y' -> compareRange y' y
-    let s = toModifiedJulianDay $ fromGregorian y' m' d'
+    YM_ y' m' -> compareRange (toMonth y' m') $ toMonth y m
-     in compareRange s $ toModifiedJulianDay x
+    YMD_ y' m' d' ->
+      let s = toModifiedJulianDay $ fromGregorian y' m' d'
+       in compareRange s $ toModifiedJulianDay x
   where
     (y, m, _) = toGregorian x
     compareRange start z
@@ -67,8 +72,8 @@ compareDate (In md offset) x = case fromMatchYMD md of
       | otherwise = if (start + fromIntegral offset - 1) < z then GT else EQ
     toMonth year month = (year * 12) + fromIntegral month
 
-dateMatches :: MatchDate -> Day -> Bool
+dateMatches :: MatchDate -> Day -> EitherErr Bool
-dateMatches md = (EQ ==) . compareDate md
+dateMatches md = fmap (EQ ==) . compareDate md
 
 valMatches :: MatchVal -> Rational -> Bool
 valMatches MatchVal {..} x =
@@ -80,55 +85,57 @@ valMatches MatchVal {..} x =
     p = 10 ^ mvPrec
     s = signum x >= 0
 
-evalSplit :: TxRecord -> ExpSplit -> RawSplit
+evalSplit :: TxRecord -> ExpSplit -> EitherErr RawSplit
-evalSplit r s@Split {sAcnt = a, sValue = v, sCurrency = c} =
+evalSplit r s@Split {sAcnt = a, sValue = v, sCurrency = c} = do
-  s
+  a_ <- evalAcnt r a
-    { sAcnt = evalAcnt r a
+  v_ <- mapM (evalExp r) v
-    , sValue = evalExp r =<< v
+  c_ <- evalCurrency r c
-    , sCurrency = evalCurrency r c
+  return (s {sAcnt = a_, sValue = v_, sCurrency = c_})
-    }
 
-evalAcnt :: TxRecord -> SplitAcnt -> T.Text
+evalAcnt :: TxRecord -> SplitAcnt -> EitherErr T.Text
 evalAcnt TxRecord {trOther = o} s = case s of
-  ConstT p -> p
+  ConstT p -> Right p
-  LookupT f -> read $ T.unpack $ lookupField f o
+  LookupT f -> lookupErr AccountField f o
-  MapT (Field f m) -> let k = lookupField f o in lookupErr "account key" k m
+  MapT (Field f m) -> do
-  Map2T (Field (f1, f2) m) ->
+    k <- lookupErr AccountField f o
-    let k1 = lookupField f1 o
+    lookupErr AccountField k m
-        k2 = lookupField f2 o
+  Map2T (Field (f1, f2) m) -> do
-     in lookupErr "account key" (k1, k2) m
+    k1 <- lookupErr AccountField f1 o
+    k2 <- lookupErr AccountField f2 o
+    lookupErr AccountField (k1, k2) m
 
-evalCurrency :: TxRecord -> SplitCur -> T.Text
+evalCurrency :: TxRecord -> SplitCur -> EitherErr T.Text
 evalCurrency TxRecord {trOther = o} s = case s of
-  ConstT p -> p
+  ConstT p -> Right p
-  LookupT f -> lookupField f o
+  LookupT f -> lookupErr CurrencyField f o
-  MapT (Field f m) -> let k = lookupField f o in lookupErr "currency key" k m
+  MapT (Field f m) -> do
-  Map2T (Field (f1, f2) m) ->
+    k <- lookupErr CurrencyField f o
-    let k1 = lookupField f1 o
+    lookupErr CurrencyField k m
-        k2 = lookupField f2 o
+  Map2T (Field (f1, f2) m) -> do
-     in lookupErr "currency key" (k1, k2) m
+    k1 <- lookupErr CurrencyField f1 o
+    k2 <- lookupErr CurrencyField f2 o
+    lookupErr CurrencyField (k1, k2) m
 
 errorT :: T.Text -> a
 errorT = error . T.unpack
 
-lookupField :: (Ord k, Show k) => k -> M.Map k v -> v
+-- lookupField :: (Ord k, Show k) => k -> M.Map k v -> v
-lookupField = lookupErr "field"
+-- lookupField = lookupErr "field"
 
-lookupErr :: (Ord k, Show k) => T.Text -> k -> M.Map k v -> v
+lookupErr :: (Ord k, Show k) => LookupField -> k -> M.Map k v -> EitherErr v
 lookupErr what k m = case M.lookup k m of
-  Just x -> x
+  Just x -> Right x
-  _ -> errorT $ T.concat [what, " does not exist: ", T.pack $ show k]
+  _ -> Left $ LookupError what $ showT k
 
 matches :: Match -> TxRecord -> EitherErr (MatchRes RawTx)
 matches Match {..} r@TxRecord {..} = do
-  let date = checkMaybe (`dateMatches` trDate) mDate
+  date <- maybe (Right True) (`dateMatches` trDate) mDate
   let val = valMatches mVal trAmount
   other <- foldM (\a o -> (a &&) <$> fieldMatches trOther o) True mOther
   desc <- maybe (return True) (matchMaybe trDesc) mDesc
-  return $
+  if date && val && desc && other
-    if date && val && desc && other
+    then maybe (Right MatchSkip) (fmap MatchPass . eval) mTx
-      then maybe MatchSkip (MatchPass . eval) mTx
+    else Right MatchFail
-      else MatchFail
   where
     eval (ToTx cur a ss) = toTx cur a ss r
 
@@ -137,32 +144,35 @@ matchMaybe q re = first (const $ RegexError re) $ pureTry $ q =~ re
 
 fieldMatches :: M.Map T.Text T.Text -> MatchOther -> EitherErr Bool
 fieldMatches dict m = case m of
-  Val (Field n mv) -> valMatches mv <$> (readRationalMsg =<< lookup_ n)
+  Val (Field n mv) -> valMatches mv <$> (readRational =<< lookup_ n)
   Desc (Field n md) -> (`matchMaybe` md) =<< lookup_ n
   where
     lookup_ n = case M.lookup n dict of
       Just r -> Right r
-      Nothing -> Left $ LookupError n
+      Nothing -> Left $ LookupError OtherField n
 
 checkMaybe :: (a -> Bool) -> Maybe a -> Bool
 checkMaybe = maybe True
 
-toTx :: SplitCur -> SplitAcnt -> [ExpSplit] -> TxRecord -> RawTx
+toTx :: SplitCur -> SplitAcnt -> [ExpSplit] -> TxRecord -> EitherErr RawTx
-toTx sc sa toSplits r@TxRecord {..} =
+toTx sc sa toSplits r@TxRecord {..} = do
-  Tx
+  a_ <- evalAcnt r sa
-    { txTags = []
+  c_ <- evalCurrency r sc
-    , txDate = trDate
+  ss_ <- mapM (evalSplit r) toSplits
-    , txDescr = trDesc
+  let fromSplit =
-    , txSplits = fromSplit : fmap (evalSplit r) toSplits
+        Split
-    }
+          { sAcnt = a_
-  where
+          , sCurrency = c_
-    fromSplit =
+          , sValue = Just trAmount
-      Split
+          , sComment = ""
-        { sAcnt = evalAcnt r sa
+          }
-        , sCurrency = evalCurrency r sc
+  return $
-        , sValue = Just trAmount
+    Tx
-        , sComment = ""
+      { txTags = []
-        }
+      , txDate = trDate
+      , txDescr = trDesc
+      , txSplits = fromSplit : ss_
+      }
 
 parseRational :: MonadFail m => T.Text -> T.Text -> m Rational
 parseRational pat s = case ms of
@@ -197,34 +207,35 @@ parseRational pat s = case ms of
       k <- readSign sign
       return (k, w)
 
-readRationalMsg :: T.Text -> EitherErr Rational
+-- readRationalMsg :: T.Text -> EitherErr Rational
-readRationalMsg t = maybe (Left $ ConversionError t) Right $ readRational t
+-- readRationalMsg t = maybe (Left $ ConversionError t) Right $ readRational t
 
--- TODO don't use a partial function
+readRational :: T.Text -> EitherErr Rational
-readRational :: MonadFail m => T.Text -> m Rational
+readRational s = case T.split (== '.') s of
-readRational s = case TP.splitOn "." s of
+  [x] -> maybe err (return . fromInteger) $ readT x
-  [x] -> return $ fromInteger $ readT x
+  [x, y] -> case (readT x, readT y) of
-  [x, y] ->
+    (Just x', Just y') ->
-    let x' = readT x
+      let p = 10 ^ T.length y
-        y' = readT y
+          k = if x' >= 0 then 1 else -1
-        p = 10 ^ T.length y
+       in return $ fromInteger x' + k * y' % p
-        k = if x' >= 0 then 1 else -1
+    _ -> err
-     in if y' > p
+  _ -> err
-          then fail "not enough precision to parse"
-          else return $ fromInteger x' + k * y' % p
-  _ -> fail $ T.unpack $ T.append "malformed decimal: " s
   where
-    readT = read . T.unpack
+    readT = readMaybe . T.unpack
+    err = Left $ 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}
 
-boundsFromGregorian :: (Gregorian, Gregorian) -> Bounds
+boundsFromGregorian :: (Gregorian, Gregorian) -> EitherErr Bounds
-boundsFromGregorian = bimap fromGregorian' fromGregorian'
+boundsFromGregorian (a, b) = do
+  a_ <- fromGregorian' a
+  b_ <- fromGregorian' b
+  return (a_, b_)
 
-fromGregorian' :: Gregorian -> Day
+fromGregorian' :: Gregorian -> EitherErr Day
-fromGregorian' = uncurry3 fromGregorian . gregTup
+fromGregorian' = fmap (uncurry3 fromGregorian) . gregTup
 
 inBounds :: Bounds -> Day -> Bool
 inBounds (d0, d1) x = d0 <= x && x <= d1
@@ -232,9 +243,11 @@ inBounds (d0, d1) x = d0 <= x && x <= d1
 inMaybeBounds :: MaybeBounds -> Day -> Bool
 inMaybeBounds (d0, d1) x = maybe True (x >=) d0 && maybe True (x <=) d1
 
-intervalMaybeBounds :: Interval -> MaybeBounds
+intervalMaybeBounds :: Interval -> EitherErr MaybeBounds
-intervalMaybeBounds Interval {intStart = s, intEnd = e} =
+intervalMaybeBounds Interval {intStart = s, intEnd = e} = do
-  (fromGregorian' <$> s, fromGregorian' <$> e)
+  s_ <- mapM fromGregorian' s
+  e_ <- mapM fromGregorian' e
+  return (s_, e_)
 
 resolveBounds :: MonadUnliftIO m => MaybeBounds -> m Bounds
 resolveBounds (s, e) = do
@@ -264,11 +277,11 @@ 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
 
-evalExp :: TxRecord -> SplitNum -> Maybe Rational
+evalExp :: TxRecord -> SplitNum -> EitherErr Rational
 evalExp r s = case s of
-  (LookupN t) -> readRational =<< M.lookup t (trOther r)
+  (LookupN t) -> readRational =<< lookupErr OtherField t (trOther r)
-  (ConstN c) -> Just $ dec2Rat c
+  (ConstN c) -> Right $ dec2Rat c
-  AmountN -> Just $ trAmount r
+  AmountN -> Right $ trAmount r
 
 dec2Rat :: Decimal -> Rational
 dec2Rat D {..} =
@@ -282,10 +295,11 @@ acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs)
 showError :: InsertError -> [T.Text]
 showError (StatementError ts ms) = (showTx <$> ts) ++ (showMatch <$> ms)
 showError other = (: []) $ case other of
+  (YearError y) -> T.append "Year must be two digits: " $ showT y
   (RegexError re) -> T.append "could not make regex from pattern: " re
   (ConversionError x) -> T.append "Could not convert to rational number: " x
-  (LookupError f) -> T.append "Could not find field: " f
+  -- TODO use the field indicator
-  -- TODO these balance errors are useless, need more info on the tx being balanced
+  (LookupError _ f) -> T.append "Could not find field: " f
   (BalanceError t cur rss) ->
     T.concat
       [ msg