ENH use normal years in dates

app/Main.hs

@@ -157,17 +157,12 @@ runDumpAccountKeys c = do
 runSync :: MonadUnliftIO m => FilePath -> m ()
 runSync c = do
   config <- readConfig c
-  catch (sync_ config) $ \case
+  migrate_ (sqlConfig config) $ do
-    InsertException _ -> liftIO $ putStrLn "insert error"
+    s <- getDBState config
-  where
+    flip runReaderT (s $ takeDirectory c) $ do
-    sync_ config = migrate_ (sqlConfig config) $ do
+      es1 <- insertBudget $ budget config
-      res <- getDBState config
+      es2 <- insertStatements config
-      case res of
+      let es = es1 ++ es2
-        Left es -> throwIO $ InsertException es
+      unless (null 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,23 +306,19 @@ indexAcntRoot r =
 getDBState
   :: MonadUnliftIO m
   => Config
-  -> SqlPersistT m (EitherErrs (FilePath -> DBState))
+  -> SqlPersistT m (FilePath -> DBState)
-getDBState c = mapM (uncurry go) $ concatEithers2 bi si (,)
+getDBState c = do
-  where
+  am <- updateAccounts $ accounts c
-    bi = intervalMaybeBounds $ budgetInterval $ global c
+  cm <- updateCurrencies $ currencies c
-    si = intervalMaybeBounds $ statementInterval $ global c
+  hs <- updateHashes c
-    go budgetInt statementInt = do
+  -- TODO not sure how I feel about this, probably will change this struct alot
-      am <- updateAccounts $ accounts c
+  -- in the future so whatever...for now
-      cm <- updateCurrencies $ currencies c
+  return $ \f ->
-      hs <- updateHashes c
+    DBState
-      -- TODO not sure how I feel about this, probably will change this struct alot
+      { kmCurrency = cm
-      -- in the future so whatever...for now
+      , kmAccount = am
-      return $ \f ->
+      , kmBudgetInterval = intervalMaybeBounds $ budgetInterval $ global c
-        DBState
+      , kmStatementInterval = intervalMaybeBounds $ statementInterval $ global c
-          { kmCurrency = cm
+      , kmNewCommits = hs
-          , kmAccount = am
+      , kmConfigDir = f
-          , kmBudgetInterval = budgetInt
+      }
-          , kmStatementInterval = statementInt
-          , kmNewCommits = hs
-          , kmConfigDir = f
-          }

lib/Internal/Insert.hs

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

lib/Internal/Statement.hs

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

lib/Internal/Utils.hs

@@ -2,7 +2,25 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
-module Internal.Utils where
+module Internal.Utils
+  ( compareDate
+  , intervalMaybeBounds
+  , fmtRational
+  , matches
+  , fromGregorian'
+  , resolveBounds
+  , leftToMaybe
+  , dec2Rat
+  , concatEithers2
+  , concatEither2
+  , parseRational
+  , showError
+  , unlessLeft
+  , unlessLefts
+  , inMaybeBounds
+  , acntPath2Text
+  )
+where
 
 import Data.Time.Format.ISO8601
 import GHC.Real
@@ -15,49 +33,39 @@ import RIO.Time
 import Text.Regex.TDFA
 
 --------------------------------------------------------------------------------
--- gregorian
+-- dates
 
-gregTup :: Gregorian -> EitherErr (Integer, Int, Int)
+gregTup :: Gregorian -> (Integer, Int, Int)
-gregTup Gregorian {..}
+gregTup Gregorian {..} =
-  | gYear > 99 = Left $ YearError gYear
+  ( fromIntegral gYear
-  | otherwise =
+  , fromIntegral gMonth
-      return
+  , fromIntegral gDay
-        ( fromIntegral gYear + 2000
+  )
-        , fromIntegral gMonth
-        , fromIntegral gDay
-        )
 
-gregMTup :: GregorianM -> EitherErr (Integer, Int)
+gregMTup :: GregorianM -> (Integer, Int)
-gregMTup GregorianM {..}
+gregMTup GregorianM {..} =
-  | gmYear > 99 = Left $ YearError gmYear
+  ( fromIntegral gmYear
-  | otherwise =
+  , fromIntegral gmMonth
-      return
+  )
-        ( fromIntegral gmYear + 2000
-        , fromIntegral gmMonth
-        )
 
-data MDY_ = Y_ Integer | YM_ Integer Int | YMD_ Integer Int Int
+data YMD_ = Y_ Integer | YM_ Integer Int | YMD_ Integer Int Int
 
-fromMatchYMD :: MatchYMD -> EitherErr MDY_
+fromMatchYMD :: MatchYMD -> YMD_
 fromMatchYMD m = case m of
-  Y y
+  Y y -> Y_ $ fromIntegral y
-    | y > 99 -> Left $ YearError y
+  YM g -> uncurry YM_ $ gregMTup g
-    | otherwise -> Right $ Y_ $ fromIntegral y + 2000
+  YMD g -> uncurry3 YMD_ $ gregTup g
-  YM g -> uncurry YM_ <$> gregMTup g
-  YMD g -> uncurry3 YMD_ <$> gregTup g
 
-compareDate :: MatchDate -> Day -> EitherErr Ordering
+compareDate :: MatchDate -> Day -> Ordering
-compareDate (On md) x = do
+compareDate (On md) x =
-  res <- fromMatchYMD md
+  case fromMatchYMD md of
-  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
-  res <- fromMatchYMD md
+  case fromMatchYMD md of
-  return $ case res of
     Y_ y' -> compareRange y' y
     YM_ y' m' -> compareRange (toMonth y' m') $ toMonth y m
     YMD_ y' m' d' ->
@@ -70,26 +78,21 @@ 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) -> EitherErrs Bounds
+-- boundsFromGregorian :: (Gregorian, Gregorian) -> Bounds
-boundsFromGregorian (a, b) = concatEither2 a_ b_ (,)
+-- boundsFromGregorian (a, b) = (fromGregorian' a, fromGregorian' b)
-  where
-    a_ = fromGregorian' a
-    b_ = fromGregorian' b
 
-fromGregorian' :: Gregorian -> EitherErr Day
+fromGregorian' :: Gregorian -> Day
-fromGregorian' = fmap (uncurry3 fromGregorian) . gregTup
+fromGregorian' = uncurry3 fromGregorian . gregTup
 
-inBounds :: Bounds -> Day -> Bool
+-- inBounds :: Bounds -> Day -> Bool
-inBounds (d0, d1) x = d0 <= x && x <= d1
+-- 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 -> EitherErrs MaybeBounds
+intervalMaybeBounds :: Interval -> MaybeBounds
-intervalMaybeBounds Interval {intStart = s, intEnd = e} = concatEither2 s_ e_ (,)
+intervalMaybeBounds Interval {intStart = s, intEnd = e} =
-  where
+  (fmap fromGregorian' s, fmap fromGregorian' e)
-    s_ = mapM fromGregorian' s
-    e_ = mapM fromGregorian' e
 
 resolveBounds :: MonadUnliftIO m => MaybeBounds -> m Bounds
 resolveBounds (s, e) = do
@@ -104,13 +107,13 @@ resolveBounds (s, e) = do
 
 matches :: Match -> TxRecord -> EitherErrs (MatchRes RawTx)
 matches Match {..} r@TxRecord {..} = do
-  res <- concatEither3 date other desc (\x y z -> x && y && z)
+  res <- concatEither2 other desc (&&)
-  if val && res
+  if date && val && res
     then maybe (Right MatchSkip) (fmap MatchPass . convert) mTx
     else Right MatchFail
   where
     val = valMatches mVal trAmount
-    date = maybe (Right True) (`dateMatches` trDate) mDate
+    date = maybe 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
@@ -146,8 +149,8 @@ valMatches MatchVal {..} x =
     s = signum x >= 0
     checkMaybe = maybe True
 
-dateMatches :: MatchDate -> Day -> EitherErr Bool
+dateMatches :: MatchDate -> Day -> Bool
-dateMatches md = fmap (EQ ==) . compareDate md
+dateMatches md = (EQ ==) . compareDate md
 
 otherMatches :: M.Map T.Text T.Text -> MatchOther -> EitherErr Bool
 otherMatches dict m = case m of
@@ -243,8 +246,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 :: (a -> b) -> Tx a -> Tx b
-mapTxSplits f t@Tx {txSplits = ss} = t {txSplits = fmap f ss}
+-- 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']
@@ -272,8 +275,6 @@ 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
@@ -346,24 +347,50 @@ 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) ->
+  (On x) -> showMatchYMD x
-    let ys = case x of
+  (In start n) -> T.concat ["[", showMatchYMD start, " ", showYMD_ end, ")"]
-          Y y -> [y]
+    where
-          YM (GregorianM {..}) -> [gmYear, gmMonth]
+      -- TODO not DRY (this shifting thing happens during the comparison
-          YMD (Gregorian {..}) -> [gYear, gMonth, gDay]
+      -- function (kinda)
-     in T.intercalate "-" $ L.take 3 (fmap showT ys ++ L.repeat "*")
+      end = case fromMatchYMD start of
-  (In _ _) -> undefined
+        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
 
--- let ys = case x of
+-- | convert YMD match to text
---       Y y -> [y]
+showMatchYMD :: MatchYMD -> T.Text
---       YM (GregorianM {..}) -> [gmYear, gmMonth]
+showMatchYMD = showYMD_ . fromMatchYMD
---       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 = undefined
+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
 
 showMatchOther :: MatchOther -> T.Text
 showMatchOther = undefined
@@ -400,21 +427,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 :: 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
+-- concatEither3 a b c fun = case (a, b, c) of
-  (Right a_, Right b_, Right c_) -> Right $ fun a_ b_ c_
+--   (Right a_, Right b_, Right c_) -> Right $ fun a_ b_ c_
-  _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b, leftToMaybe 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
+-- concatEithers3
-  :: Either [x] a
+--   :: Either [x] a
-  -> Either [x] b
+--   -> Either [x] b
-  -> Either [x] c
+--   -> Either [x] c
-  -> (a -> b -> c -> d)
+--   -> (a -> b -> c -> d)
-  -> Either [x] d
+--   -> Either [x] d
-concatEithers3 a b c = merge . concatEither3 a b c
+-- concatEithers3 a b c = merge . concatEither3 a b c
 
 concatEitherL :: [Either x a] -> Either [x] [a]
 concatEitherL as = case partitionEithers as of
@@ -446,17 +473,20 @@ merge = first concat
 -- random functions
 
 -- when bifunctor fails...
-thrice :: (a -> d) -> (b -> e) -> (c -> f) -> (a, b, c) -> (d, e, f)
+-- 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 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 :: a -> Int -> [a] -> [a]
-lpad c n s = replicate (n - length s) c ++ s
+-- lpad c n s = replicate (n - length s) c ++ s
 
-rpad :: a -> Int -> [a] -> [a]
+-- rpad :: a -> Int -> [a] -> [a]
-rpad c n s = s ++ replicate (n - length s) c
+-- 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
 
 matchMaybe :: RegexContext Regex query b => query -> T.Text -> EitherErr b
 matchMaybe q re = first (const $ RegexError re) $ pureTry $ q =~ re