app/Main.hs

@@ -157,12 +157,17 @@ runDumpAccountKeys c = do
 runSync :: MonadUnliftIO m => FilePath -> m ()
 runSync c = do
   config <- readConfig c
-  migrate_ (sqlConfig config) $ do
-    s <- getDBState config
-    flip runReaderT (s $ takeDirectory c) $ do
-      es1 <- insertBudget $ budget config
-      es2 <- insertStatements config
-      let es = es1 ++ es2
-      unless (null es) $ throwIO $ InsertException es
+  catch (sync_ config) $ \case
+    InsertException _ -> liftIO $ putStrLn "insert error"
+  where
+    sync_ config = migrate_ (sqlConfig config) $ do
+      res <- getDBState config
+      case res of
+        Left es -> throwIO $ InsertException es
+        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

@@ -306,19 +306,23 @@ indexAcntRoot r =
 getDBState
   :: MonadUnliftIO m
   => Config
-  -> SqlPersistT m (FilePath -> DBState)
-getDBState c = do
-  am <- updateAccounts $ accounts c
-  cm <- updateCurrencies $ currencies c
-  hs <- updateHashes c
-  -- 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 = intervalMaybeBounds $ budgetInterval $ global c
-      , kmStatementInterval = intervalMaybeBounds $ statementInterval $ global c
-      , kmNewCommits = hs
-      , kmConfigDir = f
-      }
+  -> SqlPersistT m (EitherErrs (FilePath -> DBState))
+getDBState c = mapM (uncurry go) $ concatEithers2 bi si (,)
+  where
+    bi = intervalMaybeBounds $ budgetInterval $ global c
+    si = intervalMaybeBounds $ statementInterval $ global c
+    go budgetInt statementInt = do
+      am <- updateAccounts $ accounts c
+      cm <- updateCurrencies $ currencies c
+      hs <- updateHashes c
+      -- 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

@@ -8,6 +8,7 @@ module Internal.Insert
   )
 where
 
+import Data.Bitraversable
 import Data.Hashable
 import Database.Persist.Class
 import Database.Persist.Sql hiding (Single, Statement)
@@ -48,19 +49,21 @@ lookupCurrency c = do
 --------------------------------------------------------------------------------
 -- intervals
 
-expandDatePat :: Bounds -> DatePat -> [Day]
-expandDatePat (a, b) (Cron cp) = filter (cronPatternMatches cp) [a .. b]
+expandDatePat :: Bounds -> DatePat -> EitherErr [Day]
+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 {mpStart = s, mpBy = b, mpUnit = u, mpRepeats = r}
-  (lower, upper) =
-    takeWhile (<= upper) $
-      (`addFun` start) . (* b')
-        <$> maybe id (take . fromIntegral) r [0 ..]
+  (lower, upper) = do
+    start <- maybe (return lower) fromGregorian' s
+    return $
+      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
@@ -118,8 +121,9 @@ mdyPatternMatches check x p = case p of
 
 insertBudget :: MonadUnliftIO m => Budget -> MappingT m [InsertError]
 insertBudget Budget {income = is, expenses = es} = do
-  mapM_ insertExpense es
-  concat <$> mapM insertIncome is
+  es1 <- mapM insertIncome is
+  es2 <- mapM insertExpense es
+  return $ concat $ es1 ++ es2
 
 -- TODO this hashes twice (not that it really matters)
 whenHash
@@ -144,21 +148,23 @@ insertIncome
     } =
     whenHash CTIncome i [] $ \c -> do
       bounds <- (liftIO . resolveBounds) =<< asks kmBudgetInterval
-      unlessLeft (balanceIncome i) $ \balanced -> do
-        forM_ (expandDatePat bounds dp) $ \day -> do
-          alloTx <- concat <$> mapM (allocationToTx from day) balanced
-          taxTx <- fmap (,Fixed) <$> mapM (taxToTx from day cur) ts
-          lift $ mapM_ (\(t, b) -> insertTxBucket (Just b) c t) $ alloTx ++ taxTx
+      case (balanceIncome i, expandDatePat bounds dp) of
+        (Right balanced, Right days) -> do
+          forM_ days $ \day -> do
+            alloTx <- concat <$> mapM (allocationToTx from day) balanced
+            taxTx <- fmap (,Fixed) <$> mapM (taxToTx from day cur) ts
+            lift $ mapM_ (\(t, b) -> insertTxBucket (Just b) c t) $ alloTx ++ taxTx
+          return []
+        (a, b) -> return $ catMaybes [leftToMaybe a, leftToMaybe b]
 
 balanceIncome :: Income -> EitherErr [BalAllocation]
 balanceIncome
   Income
     { incGross = g
-    , incWhen = dp
     , incPretax = pre
     , incTaxes = tax
     , incPosttax = post
-    } = (preRat ++) <$> balancePostTax dp bal postRat
+    } = (preRat ++) <$> balancePostTax bal postRat
     where
       preRat = mapAlloAmts dec2Rat <$> pre
       postRat = mapAlloAmts (fmap dec2Rat) <$> post
@@ -229,7 +235,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
@@ -238,11 +244,12 @@ insertExpense
     , expBucket = buc
     , expAmounts = as
     } = do
-    whenHash CTExpense e () $ \key -> mapM_ (go key) as
+    whenHash CTExpense e [] $ \key -> concat <$> mapM (go key) as
     where
       go key amt = do
-        keys <- timeAmountToTx from to cur amt
-        lift $ mapM_ (insertTxBucket (Just buc) key) keys
+        res <- timeAmountToTx from to cur amt
+        unlessLeft res $
+          lift . mapM_ (insertTxBucket (Just buc) key)
 
 timeAmountToTx
   :: MonadUnliftIO m
@@ -250,7 +257,7 @@ timeAmountToTx
   -> AcntID
   -> CurID
   -> TimeAmount
-  -> MappingT m [KeyTx]
+  -> MappingT m (EitherErr [KeyTx])
 timeAmountToTx
   from
   to
@@ -264,7 +271,7 @@ timeAmountToTx
         }
     } = do
     bounds <- (liftIO . resolveBounds) =<< asks kmBudgetInterval
-    mapM tx $ expandDatePat bounds dp
+    bimapM return (mapM tx) $ expandDatePat bounds dp
     where
       tx day = txPair day from to cur (dec2Rat v) d
 
@@ -277,10 +284,10 @@ insertStatements conf = concat <$> mapM insertStatement (statements conf)
 -- unless (null es) $ throwIO $ InsertException es
 
 insertStatement :: MonadUnliftIO m => Statement -> MappingT m [InsertError]
-insertStatement (StmtManual m) = insertManual m >> return []
+insertStatement (StmtManual m) = insertManual m
 insertStatement (StmtImport i) = insertImport i
 
-insertManual :: MonadUnliftIO m => Manual -> MappingT m ()
+insertManual :: MonadUnliftIO m => Manual -> MappingT m [InsertError]
 insertManual
   m@Manual
     { manualDate = dp
@@ -290,10 +297,11 @@ insertManual
     , manualCurrency = u
     , manualDesc = e
     } = do
-    whenHash CTManual m () $ \c -> do
+    whenHash CTManual m [] $ \c -> do
       bounds <- (liftIO . resolveBounds) =<< asks kmStatementInterval
-      ts <- mapM tx $ expandDatePat bounds dp
-      lift $ mapM_ (insertTx c) ts
+      unlessLeft (expandDatePat bounds dp) $ \days -> do
+        ts <- mapM tx days
+        lift $ mapM_ (insertTx c) ts
     where
       tx day = txPair day from to u (dec2Rat v) e
 

lib/Internal/Statement.hs

@@ -102,24 +102,27 @@ recoverZipper :: Zipped a -> [a]
 recoverZipper (Zipped as bs) = reverse as ++ bs
 
 zipperSlice
-  :: (a -> b -> Ordering)
+  :: Monad m
+  => (a -> b -> m Ordering)
   -> b
   -> Zipped a
-  -> Either (Zipped a) (Unzipped a)
+  -> m (Either (Zipped a) (Unzipped a))
 zipperSlice f x = go
   where
-    go z@(Zipped _ []) = Left z
-    go z@(Zipped bs (a : as)) =
-      case f a x of
+    go z@(Zipped _ []) = return $ Left z
+    go z@(Zipped bs (a : as)) = do
+      res <- f a x
+      case res of
         GT -> go $ Zipped (a : bs) as
-        EQ -> Right $ goEq (Unzipped bs [a] as)
-        LT -> Left z
-    goEq z@(Unzipped _ _ []) = z
-    goEq z@(Unzipped bs cs (a : as)) =
-      case f a x of
+        EQ -> Right <$> goEq (Unzipped bs [a] as)
+        LT -> return $ Left z
+    goEq z@(Unzipped _ _ []) = return z
+    goEq z@(Unzipped bs cs (a : as)) = do
+      res <- f a x
+      case res of
         GT -> goEq $ Unzipped (a : bs) cs as
         EQ -> goEq $ Unzipped bs (a : cs) as
-        LT -> z
+        LT -> return z
 
 zipperMatch :: Unzipped Match -> TxRecord -> EitherErrs (Zipped Match, MatchRes RawTx)
 zipperMatch (Unzipped bs cs as) x = go [] cs
@@ -175,8 +178,9 @@ 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
+      sliced <- zipperSlice findDate r z
+      case sliced of
         Left zipped -> go (matched, r : unmatched, zipped) rs
         Right unzipped -> do
           (z', res) <- zipperMatch unzipped r
@@ -185,7 +189,7 @@ matchDates ms = go ([], [], initZipper ms)
                 MatchSkip -> (Nothing : matched, unmatched)
                 MatchFail -> (matched, r : unmatched)
           go (m, u, z') rs
-    findDate m r = maybe EQ (`compareDate` trDate r) $ mDate m
+    findDate m r = maybe (Right EQ) (first (: []) . (`compareDate` trDate r)) $ mDate m
 
 matchNonDates :: [Match] -> [TxRecord] -> EitherErrs ([RawTx], [TxRecord], [Match])
 matchNonDates ms = go ([], [], initZipper ms)

lib/Internal/Types.hs

@@ -540,8 +540,8 @@ data AllocationSuberr
 
 data InsertError
   = RegexError T.Text
-  | -- | YearError MatchYMD
-    ConversionError T.Text
+  | YearError Natural
+  | ConversionError T.Text
   | LookupError LookupSuberr T.Text
   | BalanceError BalanceType CurID [RawSplit]
   | AllocationError AllocationSuberr DatePat

lib/Internal/Utils.hs

@@ -2,25 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
-module Internal.Utils
-  ( compareDate
-  , intervalMaybeBounds
-  , fmtRational
-  , matches
-  , fromGregorian'
-  , resolveBounds
-  , leftToMaybe
-  , dec2Rat
-  , concatEithers2
-  , concatEither2
-  , parseRational
-  , showError
-  , unlessLeft
-  , unlessLefts
-  , inMaybeBounds
-  , acntPath2Text
-  )
-where
+module Internal.Utils where
 
 import Data.Time.Format.ISO8601
 import GHC.Real
@@ -33,39 +15,49 @@ import RIO.Time
 import Text.Regex.TDFA
 
 --------------------------------------------------------------------------------
--- dates
+-- gregorian
 
-gregTup :: Gregorian -> (Integer, Int, Int)
-gregTup Gregorian {..} =
-  ( fromIntegral gYear
-  , fromIntegral gMonth
-  , fromIntegral gDay
-  )
+gregTup :: Gregorian -> EitherErr (Integer, Int, Int)
+gregTup Gregorian {..}
+  | gYear > 99 = Left $ YearError gYear
+  | otherwise =
+      return
+        ( fromIntegral gYear + 2000
+        , fromIntegral gMonth
+        , fromIntegral gDay
+        )
 
-gregMTup :: GregorianM -> (Integer, Int)
-gregMTup GregorianM {..} =
-  ( fromIntegral gmYear
-  , fromIntegral gmMonth
-  )
+gregMTup :: GregorianM -> EitherErr (Integer, Int)
+gregMTup GregorianM {..}
+  | gmYear > 99 = Left $ YearError gmYear
+  | otherwise =
+      return
+        ( fromIntegral gmYear + 2000
+        , fromIntegral gmMonth
+        )
 
-data YMD_ = Y_ Integer | YM_ Integer Int | YMD_ Integer Int Int
+data MDY_ = Y_ Integer | YM_ Integer Int | YMD_ Integer Int Int
 
-fromMatchYMD :: MatchYMD -> YMD_
+fromMatchYMD :: MatchYMD -> EitherErr MDY_
 fromMatchYMD m = case m of
-  Y y -> Y_ $ fromIntegral y
-  YM g -> uncurry YM_ $ gregMTup g
-  YMD g -> uncurry3 YMD_ $ gregTup g
+  Y y
+    | y > 99 -> Left $ YearError y
+    | otherwise -> Right $ Y_ $ fromIntegral y + 2000
+  YM g -> uncurry YM_ <$> gregMTup g
+  YMD g -> uncurry3 YMD_ <$> gregTup g
 
-compareDate :: MatchDate -> Day -> Ordering
-compareDate (On md) x =
-  case fromMatchYMD md of
+compareDate :: MatchDate -> Day -> EitherErr Ordering
+compareDate (On md) x = do
+  res <- fromMatchYMD md
+  return $ case res of
     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 = do
-  case fromMatchYMD md of
+  res <- fromMatchYMD md
+  return $ case res of
     Y_ y' -> compareRange y' y
     YM_ y' m' -> compareRange (toMonth y' m') $ toMonth y m
     YMD_ y' m' d' ->
@@ -78,21 +70,26 @@ compareDate (In md offset) x = do
       | otherwise = if (start + fromIntegral offset - 1) < z then GT else EQ
     toMonth year month = (year * 12) + fromIntegral month
 
--- boundsFromGregorian :: (Gregorian, Gregorian) -> Bounds
--- boundsFromGregorian (a, b) = (fromGregorian' a, fromGregorian' b)
+boundsFromGregorian :: (Gregorian, Gregorian) -> EitherErrs Bounds
+boundsFromGregorian (a, b) = concatEither2 a_ b_ (,)
+  where
+    a_ = fromGregorian' a
+    b_ = fromGregorian' b
 
-fromGregorian' :: Gregorian -> Day
-fromGregorian' = uncurry3 fromGregorian . gregTup
+fromGregorian' :: Gregorian -> EitherErr Day
+fromGregorian' = fmap (uncurry3 fromGregorian) . gregTup
 
--- inBounds :: Bounds -> Day -> Bool
--- inBounds (d0, d1) x = d0 <= x && x <= d1
+inBounds :: Bounds -> Day -> Bool
+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 {intStart = s, intEnd = e} =
-  (fmap fromGregorian' s, fmap fromGregorian' e)
+intervalMaybeBounds :: Interval -> EitherErrs MaybeBounds
+intervalMaybeBounds Interval {intStart = s, intEnd = e} = concatEither2 s_ e_ (,)
+  where
+    s_ = mapM fromGregorian' s
+    e_ = mapM fromGregorian' e
 
 resolveBounds :: MonadUnliftIO m => MaybeBounds -> m Bounds
 resolveBounds (s, e) = do
@@ -107,13 +104,13 @@ resolveBounds (s, e) = do
 
 matches :: Match -> TxRecord -> EitherErrs (MatchRes RawTx)
 matches Match {..} r@TxRecord {..} = do
-  res <- concatEither2 other desc (&&)
-  if date && val && res
+  res <- concatEither3 date other desc (\x y z -> x && y && z)
+  if val && res
     then maybe (Right MatchSkip) (fmap MatchPass . convert) mTx
     else Right MatchFail
   where
     val = valMatches mVal trAmount
-    date = maybe True (`dateMatches` trDate) mDate
+    date = maybe (Right True) (`dateMatches` trDate) mDate
     other = foldM (\a o -> (a &&) <$> otherMatches trOther o) True mOther
     desc = maybe (return True) (matchMaybe trDesc) mDesc
     convert (ToTx cur a ss) = toTx cur a ss r
@@ -149,8 +146,8 @@ valMatches MatchVal {..} x =
     s = signum x >= 0
     checkMaybe = maybe True
 
-dateMatches :: MatchDate -> Day -> Bool
-dateMatches md = (EQ ==) . compareDate md
+dateMatches :: MatchDate -> Day -> EitherErr Bool
+dateMatches md = fmap (EQ ==) . compareDate md
 
 otherMatches :: M.Map T.Text T.Text -> MatchOther -> EitherErr Bool
 otherMatches dict m = case m of
@@ -246,8 +243,8 @@ readRational s = case T.split (== '.') s of
     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}
+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']
@@ -275,6 +272,8 @@ 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
+  -- TODO show whole date here since this is kinda useless
+  (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
   -- TODO use the field indicator
@@ -347,50 +346,24 @@ showMatch Match {mDate = d, mVal = v, mDesc = e, mOther = o, mTimes = n, mPriori
       [] -> Nothing
       xs -> Just $ T.concat $ showMatchOther <$> xs
 
--- | Convert match date to text
--- Single date matches will just show the single date, and ranged matches will
--- show an interval like [YY-MM-DD, YY-MM-DD)
 showMatchDate :: MatchDate -> T.Text
 showMatchDate md = case md of
-  (On x) -> showMatchYMD x
-  (In start n) -> T.concat ["[", showMatchYMD start, " ", showYMD_ end, ")"]
-    where
-      -- TODO not DRY (this shifting thing happens during the comparison
-      -- function (kinda)
-      end = case fromMatchYMD start of
-        Y_ y -> Y_ $ y + fromIntegral n
-        YM_ y m ->
-          let (y_, m_) = divMod (m + fromIntegral n - 1) 12
-           in YM_ (y + fromIntegral y_) (m + m_ + 1)
-        YMD_ y m d ->
-          uncurry3 YMD_ $
-            toGregorian $
-              addDays (fromIntegral n) $
-                fromGregorian y m d
+  (On x) ->
+    let ys = case x of
+          Y y -> [y]
+          YM (GregorianM {..}) -> [gmYear, gmMonth]
+          YMD (Gregorian {..}) -> [gYear, gMonth, gDay]
+     in T.intercalate "-" $ L.take 3 (fmap showT ys ++ L.repeat "*")
+  (In _ _) -> undefined
 
--- | convert YMD match to text
-showMatchYMD :: MatchYMD -> T.Text
-showMatchYMD = showYMD_ . fromMatchYMD
+-- let ys = case x of
+--       Y y -> [y]
+--       YM (GregorianM {..}) -> [gmYear, gmMonth]
+--       YMD (Gregorian {..}) -> [gYear, gMonth, gDay]
+--  in T.intercalate "-" $ L.take 3 (fmap showT ys ++ L.repeat "*")
 
-showYMD_ :: YMD_ -> T.Text
-showYMD_ md =
-  T.intercalate "-" $ L.take 3 (fmap showT digits ++ L.repeat "*")
-  where
-    digits = case md of
-      Y_ y -> [fromIntegral y]
-      YM_ y m -> [fromIntegral y, m]
-      YMD_ y m d -> [fromIntegral y, m, d]
-
--- TODO there are errors that can be thrown here
 showMatchVal :: MatchVal -> Maybe T.Text
-showMatchVal MatchVal {mvSign = Nothing, mvNum = Nothing, mvDen = Nothing} = Nothing
-showMatchVal MatchVal {..} = Just $ T.concat [sign, num, ".", den]
-  where
-    sign = case mvSign of
-      Nothing -> "+/-"
-      Just s -> if s then "+" else "-"
-    num = maybe "*" showT mvNum
-    den = maybe "*" (lpadT '0' (fromIntegral mvPrec) . showT) mvDen
+showMatchVal = undefined
 
 showMatchOther :: MatchOther -> T.Text
 showMatchOther = undefined
@@ -427,21 +400,21 @@ concatEither2 a b fun = case (a, b) of
   (Right a_, Right b_) -> Right $ fun a_ b_
   _ -> 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]
+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
 
--- 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
+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
@@ -473,20 +446,17 @@ 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)
+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)
 
 uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
 uncurry3 f (a, b, c) = f a b c
 
--- lpad :: a -> Int -> [a] -> [a]
--- lpad c n s = replicate (n - length s) c ++ s
+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
+rpad :: a -> Int -> [a] -> [a]
+rpad c n s = s ++ replicate (n - length s) c
 
 matchMaybe :: RegexContext Regex query b => query -> T.Text -> EitherErr b
 matchMaybe q re = first (const $ RegexError re) $ pureTry $ q =~ re