packages feed

nix-tree 0.2.0 → 0.2.1

raw patch · 5 files changed

+103/−56 lines, 5 files

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # Changelog +## 0.2.1 - 2022-10-24:++* fix: Fix excessive memory use when using why-depends on large dependency graphs (issue: [@31][])++[#25]: https://github.com/utdemir/nix-tree/issues/31+ ## 0.2.0 - 2022-01-02:  * feat: Support passing flake references (issue: [#27][])
nix-tree.cabal view
@@ -3,7 +3,7 @@ name:                nix-tree synopsis:            Interactively browse a Nix store paths dependencies description:         A terminal curses application to browse a Nix store paths dependencies-version:             0.2.0+version:             0.2.1 homepage:            https://github.com/utdemir/nix-tree license:             BSD-3-Clause license-file:        LICENSE
src/NixTree/App.hs view
@@ -195,7 +195,7 @@           -- main screen           (B.VtyEvent (V.EvKey k []), Nothing)             | k `elem` [V.KChar 'q', V.KEsc] ->-              B.halt s+                B.halt s           (B.VtyEvent (V.EvKey (V.KChar '?') []), Nothing) ->             B.continue s {aeOpenModal = Just (ModalNotice helpNotice)}           (B.VtyEvent (V.EvKey (V.KChar 'w') []), Nothing) -> do@@ -217,16 +217,16 @@                 & sortPanes           (B.VtyEvent (V.EvKey k []), Nothing)             | k `elem` [V.KChar 'h', V.KLeft] ->-              B.continue $ moveLeft s+                B.continue $ moveLeft s           (B.VtyEvent (V.EvKey k []), Nothing)             | k `elem` [V.KChar 'j', V.KDown, V.KChar '\t'] ->-              B.continue $ move B.listMoveDown s+                B.continue $ move B.listMoveDown s           (B.VtyEvent (V.EvKey k []), Nothing)             | k `elem` [V.KChar 'k', V.KUp, V.KBackTab] ->-              B.continue $ move B.listMoveUp s+                B.continue $ move B.listMoveUp s           (B.VtyEvent (V.EvKey k []), Nothing)             | k `elem` [V.KChar 'l', V.KRight] ->-              B.continue $ moveRight s+                B.continue $ moveRight s           (B.VtyEvent (V.EvKey V.KPageUp []), Nothing) ->             B.continue =<< moveF B.listMovePageUp s           (B.VtyEvent (V.EvKey V.KPageDown []), Nothing) ->@@ -234,21 +234,21 @@           -- why-depends modal           (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends _))             | k `elem` [V.KChar 'q', V.KEsc] ->-              B.continue s {aeOpenModal = Nothing}+                B.continue s {aeOpenModal = Nothing}           (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends _))             | k `elem` [V.KChar 'h', V.KLeft] -> do-              B.hScrollBy (B.viewportScroll WidgetWhyDependsViewport) (-1)-              B.continue s+                B.hScrollBy (B.viewportScroll WidgetWhyDependsViewport) (-1)+                B.continue s           (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends l))             | k `elem` [V.KChar 'j', V.KDown, V.KChar '\t'] ->-              B.continue s {aeOpenModal = Just $ ModalWhyDepends (B.listMoveDown l)}+                B.continue s {aeOpenModal = Just $ ModalWhyDepends (B.listMoveDown l)}           (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends l))             | k `elem` [V.KChar 'k', V.KUp, V.KBackTab] ->-              B.continue s {aeOpenModal = Just $ ModalWhyDepends (B.listMoveUp l)}+                B.continue s {aeOpenModal = Just $ ModalWhyDepends (B.listMoveUp l)}           (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends _))             | k `elem` [V.KChar 'l', V.KRight] -> do-              B.hScrollBy (B.viewportScroll WidgetWhyDependsViewport) 1-              B.continue s+                B.hScrollBy (B.viewportScroll WidgetWhyDependsViewport) 1+                B.continue s           (B.VtyEvent (V.EvKey V.KPageUp []), Just (ModalWhyDepends l)) ->             B.listMovePageUp l >>= \l' ->               B.continue s {aeOpenModal = Just $ ModalWhyDepends l'}@@ -265,10 +265,10 @@             B.continue s {aeOpenModal = Nothing}           (B.VtyEvent (V.EvKey k []), Just (ModalSearch l r xs))             | k `elem` [V.KDown, V.KChar '\t'] ->-              B.continue s {aeOpenModal = Just $ ModalSearch l r (B.listMoveDown xs)}+                B.continue s {aeOpenModal = Just $ ModalSearch l r (B.listMoveDown xs)}           (B.VtyEvent (V.EvKey k []), Just (ModalSearch l r xs))             | k `elem` [V.KUp, V.KBackTab] ->-              B.continue s {aeOpenModal = Just $ ModalSearch l r (B.listMoveUp xs)}+                B.continue s {aeOpenModal = Just $ ModalSearch l r (B.listMoveUp xs)}           (B.VtyEvent (V.EvKey V.KLeft []), Just (ModalSearch l r xs)) ->             B.continue               s@@ -283,7 +283,7 @@                 }           (B.VtyEvent (V.EvKey (V.KChar c) []), Just (ModalSearch l r _))             | c `Set.member` allowedSearchChars ->-              B.continue (showAndUpdateSearch (l <> T.singleton c) r s)+                B.continue (showAndUpdateSearch (l <> T.singleton c) r s)           (B.VtyEvent (V.EvKey (V.KBS) []), Just (ModalSearch l r _)) ->             B.continue (showAndUpdateSearch (T.dropEnd 1 l) r s)           (B.VtyEvent (V.EvKey V.KEnter []), Just (ModalSearch _ _ xs)) ->@@ -298,7 +298,7 @@           -- notices           (B.VtyEvent (V.EvKey k []), Just (ModalNotice _))             | k `elem` [V.KChar 'q', V.KEsc] ->-              B.continue s {aeOpenModal = Nothing}+                B.continue s {aeOpenModal = Nothing}           -- handle our events           (B.AppEvent (EventTick t), _) ->             let new = s {aeCurrTime = t}@@ -339,8 +339,8 @@           Notice             "Error"             ( T.intercalate "\n" $-                "Cannot copy to clipboard: " :-                map ("  " <>) errs+                "Cannot copy to clipboard: "+                  : map ("  " <>) errs                   ++ ["Please report this as a bug."]             ) @@ -383,7 +383,9 @@             if null immediateParents               then "Immediate Parents: -"               else-                "Immediate Parents (" <> T.pack (show $ length immediateParents) <> "): "+                "Immediate Parents ("+                  <> T.pack (show $ length immediateParents)+                  <> "): "                   <> T.intercalate ", " (map storeNameToShortText immediateParents)         ]   where@@ -455,9 +457,11 @@   renderModal "Search" window   where     window =-      B.txt left B.<+> B.txt "|" B.<+> B.txt right-        B.<=> B.hBorder-        B.<=> renderList Nothing True l+      B.txt left+        B.<+> B.txt "|"+        B.<+> B.txt right+          B.<=> B.hBorder+          B.<=> renderList Nothing True l  showAndUpdateSearch :: Text -> Text -> AppEnv s -> AppEnv s showAndUpdateSearch left right env@AppEnv {aeInvertedIndex} =@@ -491,12 +495,12 @@ moveRight env@AppEnv {aePrevPane, aeCurrPane, aeNextPane, aeParents}   | null (B.listElements aeNextPane) = env   | otherwise =-    env-      { aePrevPane = aeCurrPane {B.listName = WidgetPrevPane},-        aeCurrPane = aeNextPane {B.listName = WidgetCurrPane},-        aeParents = aePrevPane : aeParents-      }-      & repopulateNextPane+      env+        { aePrevPane = aeCurrPane {B.listName = WidgetPrevPane},+          aeCurrPane = aeNextPane {B.listName = WidgetCurrPane},+          aeParents = aePrevPane : aeParents+        }+        & repopulateNextPane  repopulateNextPane :: AppEnv s -> AppEnv s repopulateNextPane env@AppEnv {aeActualStoreEnv, aeNextPane, aeSortOrder} =@@ -547,7 +551,7 @@ selectPath :: NonEmpty (Path s) -> AppEnv s -> AppEnv s selectPath path env   | (spName <$> path) == (spName <$> selectedPaths env) =-    env+      env selectPath path env@AppEnv {aeActualStoreEnv} =   let root :| children = NE.reverse path       lists =
src/NixTree/PathStats.hs view
@@ -37,8 +37,8 @@                 [ (spName, const () <$> sp)                   | sp@StorePath {spName} <- spRefs curr,                     env spName-                ] :-              map (ipsAllRefs . spPayload) (spRefs curr)+                ]+                : map (ipsAllRefs . spPayload) (spRefs curr)             )       } @@ -92,24 +92,6 @@ calculatePathStats :: StoreEnv s () -> StoreEnv s (PathStats s) calculatePathStats = mkFinalEnv . mkIntermediateEnv (const True) -whyDepends :: StoreEnv s a -> StoreName s -> [NonEmpty (StorePath s (StoreName s) a)]-whyDepends env name =-  seBottomUp-    ( \curr ->-        if spName curr == name-          then [curr {spRefs = map spName (spRefs curr)} :| []]-          else-            concat . transpose $-              map-                (map (curr {spRefs = map spName (spRefs curr)} NE.<|) . spPayload)-                (spRefs curr)-    )-    env-    & seGetRoots-    & fmap spPayload-    & concat-    & map NE.reverse- -- TODO: This can be precomputed. shortestPathTo :: StoreEnv s a -> StoreName s -> NonEmpty (StorePath s (StoreName s) a) shortestPathTo env name =@@ -135,3 +117,57 @@     & minimumBy (comparing fst)     & snd     & NE.reverse++-- Why depends implementation++-- We iterate the dependency graph bottom up. Every node contains a set of paths which represent+-- the why-depends output from that node down. The set of paths is represented as a "Treeish" object,+-- which is a trie-like structure.+whyDepends :: forall s a. StoreEnv s a -> StoreName s -> [NonEmpty (StorePath s (StoreName s) a)]+whyDepends env name =+  seBottomUp @_ @_ @(Maybe (Treeish (StorePath s (StoreName s) a)))+    ( \curr ->+        if spName curr == name+          then Just $ mkTreeish (curr {spRefs = map spName (spRefs curr)}) []+          else+            spRefs curr+              & map spPayload+              & catMaybes+              & NE.nonEmpty+              <&> NE.toList+              <&> mkTreeish (curr {spRefs = map spName (spRefs curr)})+              <&> capTreeish 1_000_000+    )+    env+    & seGetRoots+    & fmap spPayload+    & NE.toList+    & catMaybes+    & take 10000+    & concatMap treeishToList++-- A trie-like structure which also caches the size.+data Treeish a = Treeish Int a [Treeish a]++mkTreeish :: a -> [Treeish a] -> Treeish a+mkTreeish a ts = Treeish (1 + sum (map (\(Treeish i _ _) -> i) ts)) a ts++treeishSize :: Treeish a -> Int+treeishSize (Treeish i _ _) = i++capTreeish :: Int -> Treeish a -> Treeish a+capTreeish cap (Treeish i a ts)+  | i <= cap = Treeish i a ts+  | otherwise = Treeish cap a (go cap ts)+  where+    go _ [] = []+    go remaining (x : xs) =+      let x' = capTreeish remaining x+          remaining' = remaining - treeishSize x'+       in if remaining > 0+            then x' : go remaining' xs+            else [x']++treeishToList :: Treeish a -> [NonEmpty a]+treeishToList (Treeish _ a []) = [a :| []]+treeishToList (Treeish _ a xs) = map (a NE.<|) (concatMap treeishToList xs)
src/NixTree/StorePath.hs view
@@ -203,7 +203,8 @@   nixVersion <- liftIO getNixVersion    when (isDerivation && nixVersion < Nix2_4) $-    liftIO $ hPutStrLn stderr "Warning: --derivation flag is ignored on Nix versions older than 2.4."+    liftIO $+      hPutStrLn stderr "Warning: --derivation flag is ignored on Nix versions older than 2.4."    roots <-     liftIO $@@ -261,11 +262,11 @@       | HS.member name visited = (acc, visited)       | not (predicate name) = (acc, visited)       | otherwise =-        let sp@StorePath {spRefs} = seLookup env name-         in foldl'-              (\(acc', visited') name' -> go acc' visited' name')-              (sp : acc, HS.insert name visited)-              spRefs+          let sp@StorePath {spRefs} = seLookup env name+           in foldl'+                (\(acc', visited') name' -> go acc' visited' name')+                (sp : acc, HS.insert name visited)+                spRefs  seBottomUp ::   forall s a b.