packages feed

nix-tree 0.6.1 → 0.6.3

raw patch · 5 files changed

+153/−84 lines, 5 files

Files

CHANGELOG.md view
@@ -1,5 +1,17 @@ # Changelog +##  0.6.3 - 2025-05-18:++* feat: Disambiguate store paths with the same name (thanks @lf-, issue: [#119])++## 0.6.2 - 2025-02-25:++* fix: Fix a failure when the store path does not have a signature. (thanks @minhtrancccp, issue [#114])+* chore: Update flake description to remove deprecated 'defaultPackage' field (thanks @minhtrancccp, issue [#113])++#[113]: https://github.com/utdemir/nix-tree/issues/113+[#114]: https://github.com/utdemir/nix-tree/issues/114+ ## 0.6.1 - 2025-01-25:  * chore: Relax brick upper bound to work with newer Stackage snapshot
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.6.1+version:             0.6.3 homepage:            https://github.com/utdemir/nix-tree license:             BSD-3-Clause license-file:        LICENSE
src/NixTree/App.hs view
@@ -38,8 +38,8 @@  data Modal s   = ModalNotice Notice-  | ModalWhyDepends (B.GenericList Widgets Seq (NonEmpty (Path s)))-  | ModalSearch Text Text (B.GenericList Widgets Seq (Path s))+  | ModalWhyDepends (B.GenericList Widgets Seq (NonEmpty Path))+  | ModalSearch Text Text (B.GenericList Widgets Seq Path)  succCycle :: forall a. (Bounded a, Enum a) => a -> a succCycle a@@ -47,21 +47,21 @@   | otherwise = succ a  data AppEnv s = AppEnv-  { aeActualStoreEnv :: StoreEnv s (PathStats s),-    aeInvertedIndex :: InvertedIndex (Path s),-    aePrevPane :: List s,-    aeCurrPane :: List s,-    aeNextPane :: List s,-    aeParents :: [List s],+  { aeActualStoreEnv :: StoreEnv PathStats,+    aeInvertedIndex :: InvertedIndex Path,+    aePrevPane :: List,+    aeCurrPane :: List,+    aeNextPane :: List,+    aeParents :: [List],     aeOpenModal :: Maybe (Modal s),     aeSortOrder :: SortOrder,     aeSortOrderLastChanged :: Clock.TimeSpec,     aeCurrTime :: Clock.TimeSpec   } -type Path s = StorePath s (StoreName s) (PathStats s)+type Path = StorePath StoreName PathStats -type List s = B.GenericList Widgets Seq (Path s)+type List = B.GenericList Widgets Seq Path  data SortOrder   = SortOrderAlphabetical@@ -71,12 +71,12 @@  B.suffixLenses ''AppEnv -_ModalWhyDepends :: Traversal' (Modal s) (B.GenericList Widgets Seq (NonEmpty (Path s)))+_ModalWhyDepends :: Traversal' (Modal s) (B.GenericList Widgets Seq (NonEmpty Path)) _ModalWhyDepends f m = case m of   ModalWhyDepends l -> ModalWhyDepends <$> f l   _ -> pure m -compareBySortOrder :: SortOrder -> Path s -> Path s -> Ordering+compareBySortOrder :: SortOrder -> Path -> Path -> Ordering compareBySortOrder SortOrderAlphabetical = compare `on` T.toLower . storeNameToShortText . spName compareBySortOrder SortOrderClosureSize = compare `on` Down . psTotalSize . spPayload compareBySortOrder SortOrderAddedSize = compare `on` Down . psAddedSize . spPayload@@ -85,7 +85,7 @@ attrTerminal = B.attrName "terminal" attrUnderlined = B.attrName "underlined" -run :: StoreEnv s (PathStats s) -> IO ()+run :: StoreEnv PathStats -> IO () run env = do   -- Create the inverted index, and start evaluating it in the background   let ii = iiFromList . toList . fmap (\sp -> (storeNameToText (spName sp), sp)) $ seAll env@@ -142,14 +142,14 @@ renderList ::   Maybe SortOrder ->   Bool ->-  List s ->+  List ->   B.Widget Widgets renderList highlightSort =   B.renderList     ( \_        StorePath          { spName,-           spPayload = PathStats {psTotalSize, psAddedSize},+           spPayload = PathStats {psTotalSize, psAddedSize, psDisambiguationChars},            spRefs,            spSignatures          } ->@@ -162,7 +162,7 @@                   [ if null spSignatures                       then B.txt "  "                       else B.txt "✓ ",-                    B.txt (storeNameToShortText spName)+                    B.txt (storeNameToShortTextWithDisambiguation psDisambiguationChars spName)                       & underlineWhen SortOrderAlphabetical                       & B.padRight (B.Pad 1)                       & B.padRight B.Max,@@ -336,7 +336,7 @@             ]         ) -yankToClipboard :: StoreName s -> IO (Either Notice ())+yankToClipboard :: StoreName -> IO (Either Notice ()) yankToClipboard p =   Clipboard.copy (toText $ storeNameToPath p)     <&> \case@@ -438,7 +438,7 @@ renderNotice (Notice title txt) = renderModal title (B.txt txt)  renderWhyDependsModal ::-  B.GenericList Widgets Seq (NonEmpty (Path s)) ->+  B.GenericList Widgets Seq (NonEmpty Path) ->   B.Widget Widgets renderWhyDependsModal l =   B.renderList renderDepends True l@@ -468,7 +468,7 @@                   (fromMaybe 0 $ ((==) `on` fmap spName) route `S.findIndexL` xs)     } -renderSearchModal :: Text -> Text -> B.GenericList Widgets Seq (Path s) -> B.Widget Widgets+renderSearchModal :: Text -> Text -> B.GenericList Widgets Seq Path -> B.Widget Widgets renderSearchModal left right l =   renderModal "Search" window   where@@ -490,10 +490,10 @@               & S.fromList        in B.list WidgetSearch xs 1 -move :: (List s -> List s) -> B.EventM n (AppEnv s) ()+move :: (List -> List) -> B.EventM n (AppEnv s) () move = moveF . modify -moveF :: B.EventM n (List s) () -> B.EventM n (AppEnv s) ()+moveF :: B.EventM n List () -> B.EventM n (AppEnv s) () moveF f = do   B.zoom aeCurrPaneL f   modify repopulateNextPane@@ -534,7 +534,7 @@               aeNextPane         } -sortPane :: SortOrder -> List s -> List s+sortPane :: SortOrder -> List -> List sortPane so l =   let selected = B.listSelectedElement l       elems =@@ -552,10 +552,10 @@       aePrevPane = sortPane aeSortOrder aePrevPane     } -selectedPath :: AppEnv s -> Path s+selectedPath :: AppEnv s -> Path selectedPath = NE.head . selectedPaths -selectedPaths :: AppEnv s -> NonEmpty (Path s)+selectedPaths :: AppEnv s -> NonEmpty Path selectedPaths AppEnv {aePrevPane, aeCurrPane, aeParents} =   let parents =         mapMaybe@@ -565,7 +565,7 @@         Nothing -> error "invariant violation: no selected element"         Just (_, p) -> p :| parents -selectPath :: NonEmpty (Path s) -> AppEnv s -> AppEnv s+selectPath :: NonEmpty Path -> AppEnv s -> AppEnv s selectPath path env   | (spName <$> path) == (spName <$> selectedPaths env) =       env@@ -602,9 +602,9 @@ mkList ::   SortOrder ->   n ->-  Seq (Path s) ->-  Maybe (Path s) ->-  B.GenericList n Seq (Path s)+  Seq Path ->+  Maybe Path ->+  B.GenericList n Seq Path mkList sortOrder name possible selected =   let contents = S.sortBy (compareBySortOrder sortOrder) possible    in B.list name contents 1
src/NixTree/PathStats.hs view
@@ -13,21 +13,22 @@ import qualified Data.Set as S import NixTree.StorePath -data IntermediatePathStats s = IntermediatePathStats-  { ipsAllRefs :: M.Map (StoreName s) (StorePath s (StoreName s) ())+data IntermediatePathStats = IntermediatePathStats+  { ipsAllRefs :: M.Map StoreName (StorePath StoreName ())   } -data PathStats s = PathStats+data PathStats = PathStats   { psTotalSize :: !Int,     psAddedSize :: !Int,-    psImmediateParents :: [StoreName s]+    psImmediateParents :: [StoreName],+    psDisambiguationChars :: !Int   }   deriving (Show, Generic, NFData)  mkIntermediateEnv ::-  (StoreName s -> Bool) ->-  StoreEnv s () ->-  StoreEnv s (IntermediatePathStats s)+  (StoreName -> Bool) ->+  StoreEnv () ->+  StoreEnv IntermediatePathStats mkIntermediateEnv env =   seBottomUp $ \curr ->     IntermediatePathStats@@ -42,10 +43,11 @@             )       } -mkFinalEnv :: StoreEnv s (IntermediatePathStats s) -> StoreEnv s (PathStats s)+mkFinalEnv :: StoreEnv IntermediatePathStats -> StoreEnv PathStats mkFinalEnv env =   let totalSize = calculateEnvSize env       immediateParents = calculateImmediateParents (sePaths env)+      disambiguationChars = seDisambiguationChars env    in flip seBottomUp env $ \StorePath {spName, spSize, spPayload} ->         let filteredSize =               seFetchRefs env (/= spName) (seRoots env)@@ -57,10 +59,13 @@                     + calculateRefsSize (ipsAllRefs spPayload),                 psAddedSize = addedSize,                 psImmediateParents =-                  maybe [] S.toList $ M.lookup spName immediateParents+                  maybe [] S.toList $ M.lookup spName immediateParents,+                psDisambiguationChars =+                  M.lookup spName disambiguationChars+                    & maybe 0 id               }   where-    calculateEnvSize :: StoreEnv s (IntermediatePathStats s) -> Int+    calculateEnvSize :: StoreEnv IntermediatePathStats -> Int     calculateEnvSize e =       seGetRoots e         & toList@@ -73,12 +78,12 @@           )         & M.unions         & calculateRefsSize-    calculateRefsSize :: (Functor f, Foldable f) => f (StorePath s a b) -> Int+    calculateRefsSize :: (Functor f, Foldable f) => f (StorePath a b) -> Int     calculateRefsSize = sum . fmap spSize     calculateImmediateParents ::       (Foldable f) =>-      f (StorePath s (StoreName s) b) ->-      M.Map (StoreName s) (S.Set (StoreName s))+      f (StorePath StoreName b) ->+      M.Map StoreName (S.Set StoreName)     calculateImmediateParents =       foldl'         ( \m StorePath {spName, spRefs} ->@@ -89,11 +94,56 @@         )         M.empty -calculatePathStats :: StoreEnv s () -> StoreEnv s (PathStats s)+    seShortNames :: StoreEnv a -> M.Map Text [StoreName]+    seShortNames env =+      let paths = seAll env & toList+       in foldl'+            ( \m StorePath {spName} ->+                let (_, shortName) = storeNameToSplitShortText spName+                 in M.alter+                      ( \case+                          Nothing -> Just [spName]+                          Just xs -> Just (spName : xs)+                      )+                      shortName+                      m+            )+            M.empty+            paths++    seDisambiguationChars :: StoreEnv a -> M.Map StoreName Int+    seDisambiguationChars env =+      M.toList (seShortNames env)+        & map snd+        & concatMap+          ( \xs ->+              let chrs = disambiguate xs+               in map (\x -> (x, chrs)) xs+          )+        & M.fromList++    disambiguate :: [StoreName] -> Int+    disambiguate xs = go 0+      where+        go n =+          if isGood n+            then n+            else go (n + 2)++        isGood n =+          xs+            & map (storeNameToShortTextWithDisambiguation n)+            & allUnique++        allUnique xx =+          let unique = S.fromList xx+           in length unique == length xx++calculatePathStats :: StoreEnv () -> StoreEnv PathStats calculatePathStats = mkFinalEnv . mkIntermediateEnv (const True)  -- TODO: This can be precomputed.-shortestPathTo :: StoreEnv s a -> StoreName s -> NonEmpty (StorePath s (StoreName s) a)+shortestPathTo :: StoreEnv a -> StoreName -> NonEmpty (StorePath StoreName a) shortestPathTo env name =   seBottomUp     ( \curr ->@@ -121,9 +171,9 @@ -- 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 :: forall a. StoreEnv a -> StoreName -> [NonEmpty (StorePath StoreName a)] whyDepends env name =-  seBottomUp @_ @_ @(Maybe (Treeish (StorePath s (StoreName s) a)))+  seBottomUp @_ @(Maybe (Treeish (StorePath StoreName a)))     ( \curr ->         if spName curr == name           then Just $ mkTreeish (curr {spRefs = map spName (spRefs curr)}) []
src/NixTree/StorePath.hs view
@@ -4,6 +4,7 @@     storeNameToText,     storeNameToShortText,     storeNameToSplitShortText,+    storeNameToShortTextWithDisambiguation,     NixPathSignature (..),     StorePath (..),     Installable (..),@@ -20,7 +21,7 @@   ) where -import Data.Aeson (FromJSON (..), Value (..), decode, (.:))+import Data.Aeson (FromJSON (..), Value (..), decode, eitherDecode, (.!=), (.:), (.:?)) import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import Data.Aeson.Types (Parser)@@ -70,11 +71,11 @@  -------------------------------------------------------------------------------- -data StoreName s = StoreName NixStore Text+data StoreName = StoreName NixStore Text   deriving stock (Show, Eq, Ord, Generic)   deriving anyclass (NFData, Hashable) -mkStoreName :: NixStore -> FilePath -> Maybe (StoreName a)+mkStoreName :: NixStore -> FilePath -> Maybe StoreName mkStoreName ns path = do   let ps = unNixStore ns   guard $ ps `isPrefixOf` path@@ -82,18 +83,24 @@   sn <- listToMaybe ds   return $ StoreName ns (toText sn) -storeNameToText :: StoreName a -> Text+storeNameToText :: StoreName -> Text storeNameToText (StoreName _ n) = n -storeNameToPath :: StoreName a -> FilePath+storeNameToPath :: StoreName -> FilePath storeNameToPath (StoreName ns sn) = unNixStore ns </> toString sn -storeNameToShortText :: StoreName a -> Text+storeNameToShortText :: StoreName -> Text storeNameToShortText = snd . storeNameToSplitShortText -storeNameToSplitShortText :: StoreName a -> (Text, Text)+storeNameToShortTextWithDisambiguation :: Int -> StoreName -> Text+storeNameToShortTextWithDisambiguation 0 sn = storeNameToShortText sn+storeNameToShortTextWithDisambiguation n (StoreName ns sn) =+  let (f, s) = storeNameToSplitShortText (StoreName ns sn)+   in T.take n f <> "...-" <> s++storeNameToSplitShortText :: StoreName -> (Text, Text) storeNameToSplitShortText txt =-  case T.span (/= '-') . T.pack $ storeNameToPath txt of+  case T.span (/= '-') $ storeNameToText txt of     (f, s) | Just (c, s'') <- T.uncons s -> (T.snoc f c, s'')     e -> e @@ -137,8 +144,8 @@  -------------------------------------------------------------------------------- -data StorePath s ref payload = StorePath-  { spName :: StoreName s,+data StorePath ref payload = StorePath+  { spName :: StoreName,     spSize :: Int,     spRefs :: [ref],     spPayload :: payload,@@ -146,7 +153,7 @@   }   deriving (Show, Eq, Ord, Functor, Generic) -instance (NFData a, NFData b) => NFData (StorePath s a b)+instance (NFData a, NFData b) => NFData (StorePath a b)  newtype Installable = Installable {installableToText :: Text} @@ -160,10 +167,10 @@     pioFile :: Maybe FilePath   } -getPathInfo :: NixStore -> NixVersion -> PathInfoOptions -> NonEmpty Installable -> IO (NonEmpty (StorePath s (StoreName s) ()))+getPathInfo :: NixStore -> NixVersion -> PathInfoOptions -> NonEmpty Installable -> IO (NonEmpty (StorePath StoreName ())) getPathInfo nixStore nixVersion options names = do   infos <--    decode @NixPathOutput+    eitherDecode @NixPathOutput       <$> readProcessStdout_         ( proc             "nix"@@ -183,7 +190,7 @@                 ++ map (toString . installableToText) (toList names)             )         )-      >>= maybe (fail "Failed parsing nix path-info output.") return+      >>= either (\e -> fail $ "Failed parsing nix path-info output: " ++ show e) return       >>= mapM assertValidInfo . npoResults       >>= maybe (fail "invariant violation: getPathInfo returned []") return . nonEmpty @@ -212,9 +219,9 @@  -------------------------------------------------------------------------------- -data StoreEnv s payload = StoreEnv-  { sePaths :: HashMap (StoreName s) (StorePath s (StoreName s) payload),-    seRoots :: NonEmpty (StoreName s)+data StoreEnv payload = StoreEnv+  { sePaths :: HashMap StoreName (StorePath StoreName payload),+    seRoots :: NonEmpty StoreName   }   deriving (Functor, Generic, NFData) @@ -230,7 +237,7 @@   (MonadIO m) =>   StoreEnvOptions ->   NonEmpty Installable ->-  (forall s. StoreEnv s () -> m a) ->+  (StoreEnv () -> m a) ->   m a withStoreEnv StoreEnvOptions {seoIsDerivation, seoIsImpure, seoStoreURL, seoFile} names cb = do   nixStore <- liftIO $ getStoreDir seoStoreURL@@ -268,26 +275,26 @@           (roots <&> spName)   cb env -seLookup :: StoreEnv s a -> StoreName s -> StorePath s (StoreName s) a+seLookup :: StoreEnv a -> StoreName -> StorePath StoreName a seLookup StoreEnv {sePaths} name =   fromMaybe     (error $ "invariant violation, StoreName not found: " <> show name)     (HM.lookup name sePaths) -seAll :: StoreEnv s a -> NonEmpty (StorePath s (StoreName s) a)+seAll :: StoreEnv a -> NonEmpty (StorePath StoreName a) seAll StoreEnv {sePaths} = case HM.elems sePaths of   [] -> error "invariant violation: no paths"   (x : xs) -> x :| xs -seGetRoots :: StoreEnv s a -> NonEmpty (StorePath s (StoreName s) a)+seGetRoots :: StoreEnv a -> NonEmpty (StorePath StoreName a) seGetRoots env@StoreEnv {seRoots} =   fmap (seLookup env) seRoots  seFetchRefs ::-  StoreEnv s a ->-  (StoreName s -> Bool) ->-  NonEmpty (StoreName s) ->-  [StorePath s (StoreName s) a]+  StoreEnv a ->+  (StoreName -> Bool) ->+  NonEmpty StoreName ->+  [StorePath StoreName a] seFetchRefs env predicate =   fst     . foldl'@@ -305,10 +312,10 @@                 spRefs  seBottomUp ::-  forall s a b.-  (StorePath s (StorePath s (StoreName s) b) a -> b) ->-  StoreEnv s a ->-  StoreEnv s b+  forall a b.+  (StorePath (StorePath StoreName b) a -> b) ->+  StoreEnv a ->+  StoreEnv b seBottomUp f StoreEnv {sePaths, seRoots} =   StoreEnv     { sePaths = snd $ execState (mapM_ go seRoots) (sePaths, HM.empty),@@ -320,12 +327,12 @@         (error $ "invariant violation: name doesn't exists: " <> show k)         (HM.lookup k m)     go ::-      StoreName s ->+      StoreName ->       State-        ( HashMap (StoreName s) (StorePath s (StoreName s) a),-          HashMap (StoreName s) (StorePath s (StoreName s) b)+        ( HashMap StoreName (StorePath StoreName a),+          HashMap StoreName (StorePath StoreName b)         )-        (StorePath s (StoreName s) b)+        (StorePath StoreName b)     go name = do       processed <- gets snd       case name `HM.lookup` processed of@@ -339,7 +346,7 @@  -------------------------------------------------------------------------------- -storeEnvToDot :: StoreEnv s a -> Text+storeEnvToDot :: StoreEnv a -> Text storeEnvToDot env =   seBottomUp go env     & seGetRoots@@ -352,7 +359,7 @@       fromList [Set.singleton (spName sp, spName ref) <> spPayload ref | ref <- spRefs sp]         & mconcat -    render :: Set (StoreName s, StoreName s) -> Text+    render :: Set (StoreName, StoreName) -> Text     render edges =       Dot.DotGraph         Dot.Strict@@ -367,7 +374,7 @@         ]         & Dot.encode -    mkNodeId :: StoreName s -> Dot.NodeId+    mkNodeId :: StoreName -> Dot.NodeId     mkNodeId = fromString . toString . storeNameToShortText  --------------------------------------------------------------------------------@@ -405,7 +412,7 @@               <$> obj .: "path"               <*> obj .: "narSize"               <*> obj .: "references"-              <*> obj .: "signatures"+              <*> (obj .:? "signatures" .!= [])           )   )     <|> ( do@@ -423,7 +430,7 @@             path             <$> obj .: "narSize"             <*> obj .: "references"-            <*> obj .: "signatures"+            <*> (obj .:? "signatures" .!= [])         ) parse2_19 (path, Null) = return $ NixPathInfoInvalid path parse2_19 (_, _) = fail "Expecting an object or null"