ndwarshuis
/
pwncash
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH clean up errors in ops

This commit is contained in:
Nathan Dwarshuis 2023-01-27 20:54:25 -05:00
parent 6a43a9a78a
commit 1253cd5b61
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lib/Internal/Database/Ops.hs
View File

@ -31,6 +31,7 @@ import RIO hiding (LogFunc, isNothing, on, (^.))
import RIO.List ((\\)) import RIO.List ((\\))
import qualified RIO.List as L import qualified RIO.List as L
import qualified RIO.Map as M import qualified RIO.Map as M
import qualified RIO.NonEmpty as N
import qualified RIO.Text as T import qualified RIO.Text as T
migrate_ migrate_
@ -243,13 +244,13 @@ paths2IDs =
. L.sortOn fst . L.sortOn fst
. fmap (first pathList) . fmap (first pathList)
where where
pathList (AcntPath t ns) = reverse $ atName t : ns pathList (AcntPath t []) = atName t :| []
pathList (AcntPath t ns) = N.reverse $ atName t :| ns
trimNames :: [[T.Text]] -> [AcntID] -- none of these errors should fire assuming that input is sorted and unique
trimNames = fmap fmt . trimAll 0 trimNames :: [N.NonEmpty T.Text] -> [AcntID]
trimNames = fmap (T.intercalate "_" . reverse) . trimAll 0
where where
fmt [] = err "blank path"
fmt ys = T.intercalate "_" $ reverse ys
trimAll _ [] = [] trimAll _ [] = []
trimAll i (y : ys) = case L.foldl' (matchPre i) (y, [], []) ys of trimAll i (y : ys) = case L.foldl' (matchPre i) (y, [], []) ys of
(a, [], bs) -> reverse $ trim i a : bs (a, [], bs) -> reverse $ trim i a : bs
@ -268,10 +269,10 @@ trimNames = fmap fmt . trimAll 0
[] -> [trim i y] [] -> [trim i y]
_ -> trimAll (i + 1) (reverse $ y : ys) _ -> trimAll (i + 1) (reverse $ y : ys)
in (new, [], reverse next ++ old) in (new, [], reverse next ++ old)
trim i = take (i + 1) trim i = N.take (i + 1)
err msg = errorWithoutStackTrace $ "Import.Database.Ops.hs: " ++ msg err msg = errorWithoutStackTrace $ "Import.Database.Ops.hs: " ++ msg
(!?) :: [a] -> Int -> Maybe a (!?) :: N.NonEmpty a -> Int -> Maybe a
xs !? n xs !? n
| n < 0 = Nothing | n < 0 = Nothing
-- Definition adapted from GHC.List -- Definition adapted from GHC.List