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