nix-tree 0.1.0.0 → 0.1.1.0
raw patch · 7 files changed
+249/−47 lines, 7 files
Files
- README.md +15/−0
- nix-tree.cabal +2/−1
- src/App.hs +112/−36
- src/InvertedIndex.hs +82/−0
- src/Main.hs +1/−0
- src/PathStats.hs +29/−8
- src/StorePath.hs +8/−2
README.md view
@@ -1,12 +1,24 @@ # nix-tree ++[](https://repology.org/project/nix-tree/versions)++ Interactively browse the dependency graph of your Nix derivations. [](https://asciinema.org/a/ahDveBL1gs5t36z1myePtrKpR) ## Installation +From nixpkgs-unstable:+ ```+nix-env -iA nix-tree -f https://github.com/nixos/nixpkgs/archive/nixpkgs-unstable.tar.gz+```++Development version:++``` nix-env -iA nix-tree -f https://github.com/utdemir/nix-tree/archive/master.tar.gz ``` @@ -22,6 +34,8 @@ home.packages = [ pkgs.nix-tree ]; ``` ++ ## Usage ```@@ -33,6 +47,7 @@ hjkl/Arrow Keys : Navigate q/Esc: : Quit / close modal w : Open why-depends mode+ / : Open search mode i : Toggle modeline ? : Show help ```
nix-tree.cabal view
@@ -1,7 +1,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.1.0.0+version: 0.1.1.0 homepage: https://github.com/utdemir/nix-tree license: BSD3 author: Utku Demir@@ -19,6 +19,7 @@ other-modules: PathStats StorePath App+ InvertedIndex ghc-options: -Wall -fno-warn-name-shadowing -threaded -O2 -threaded build-depends: base >= 4.11 && < 5 , aeson
src/App.hs view
@@ -11,8 +11,10 @@ import qualified Brick.Widgets.List as B import qualified Data.List.NonEmpty as NE import qualified Data.Sequence as S+import qualified Data.Set as Set import qualified Data.Text as T import qualified Graphics.Vty as V+import InvertedIndex import PathStats import Protolude import qualified System.HrfSize as HRF@@ -22,14 +24,17 @@ | WidgetCurrPane | WidgetNextPane | WidgetWhyDepends+ | WidgetSearch deriving (Show, Eq, Ord) data Modal s = ModalHelp | ModalWhyDepends (B.GenericList Widgets Seq (NonEmpty (Path s)))+ | ModalSearch Text Text (B.GenericList Widgets Seq (Path s)) data AppEnv s = AppEnv { aeActualStoreEnv :: StoreEnv s (PathStats s),+ aeInvertedIndex :: InvertedIndex, aePrevPane :: List s, aeCurrPane :: List s, aeNextPane :: List s,@@ -46,26 +51,31 @@ attrTerminal = "terminal" run :: StoreEnv s (PathStats s) -> IO ()-run env = void $ B.defaultMain app appEnv+run env = void . B.defaultMain app =<< appEnv where- appEnv =- AppEnv- { aeActualStoreEnv =- env,- aePrevPane =- B.list WidgetPrevPane S.empty 0,- aeCurrPane =- B.list WidgetCurrPane (S.fromList . NE.toList $ seGetRoots env) 0,- aeNextPane =- B.list WidgetNextPane S.empty 0,- aeParents =- [],- aeOpenModal =- Nothing,- aeShowInfoPane =- True- }- & repopulateNextPane+ appEnv = do+ let ii = iiFromList . toList . map (storeNameToText . spName) $ seAll env+ _ <- forkIO $ evaluate (rnf ii)+ return $+ AppEnv+ { aeActualStoreEnv =+ env,+ aeInvertedIndex =+ ii,+ aePrevPane =+ B.list WidgetPrevPane S.empty 0,+ aeCurrPane =+ B.list WidgetCurrPane (S.fromList . NE.toList $ seGetRoots env) 0,+ aeNextPane =+ B.list WidgetNextPane S.empty 0,+ aeParents =+ [],+ aeOpenModal =+ Nothing,+ aeShowInfoPane =+ True+ }+ & repopulateNextPane renderList :: Bool ->@@ -107,7 +117,8 @@ [ case aeOpenModal of Nothing -> B.emptyWidget Just ModalHelp -> renderHelpModal- Just (ModalWhyDepends l) -> renderWhyDependsModal l,+ Just (ModalWhyDepends l) -> renderWhyDependsModal l+ Just (ModalSearch l r xs) -> renderSearchModal l r xs, renderMainScreen env ], B.appChooseCursor = \_ -> const Nothing,@@ -121,16 +132,18 @@ B.continue s {aeOpenModal = Just ModalHelp} (B.VtyEvent (V.EvKey (V.KChar 'w') []), Nothing) -> B.continue $ showWhyDepends s+ (B.VtyEvent (V.EvKey (V.KChar '/') []), Nothing) ->+ B.continue $ showAndUpdateSearch "" "" s (B.VtyEvent (V.EvKey (V.KChar 'i') []), Nothing) -> B.continue $ s {aeShowInfoPane = not (aeShowInfoPane s)} (B.VtyEvent (V.EvKey k []), Nothing) | k `elem` [V.KChar 'h', V.KLeft] -> B.continue $ moveLeft s (B.VtyEvent (V.EvKey k []), Nothing)- | k `elem` [V.KChar 'j', V.KDown] ->+ | k `elem` [V.KChar 'j', V.KDown, V.KChar '\t'] -> B.continue $ move B.listMoveDown s (B.VtyEvent (V.EvKey k []), Nothing)- | k `elem` [V.KChar 'k', V.KUp] ->+ | k `elem` [V.KChar 'k', V.KUp, V.KBackTab] -> B.continue $ move B.listMoveUp s (B.VtyEvent (V.EvKey k []), Nothing) | k `elem` [V.KChar 'l', V.KRight] ->@@ -145,10 +158,10 @@ B.continue s {aeOpenModal = Nothing} -- why-depends modal (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends l))- | k `elem` [V.KChar 'j', V.KDown] ->+ | k `elem` [V.KChar 'j', V.KDown, V.KChar '\t'] -> B.continue s {aeOpenModal = Just $ ModalWhyDepends (B.listMoveDown l)} (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends l))- | k `elem` [V.KChar 'k', V.KUp] ->+ | k `elem` [V.KChar 'k', V.KUp, V.KBackTab] -> B.continue s {aeOpenModal = Just $ ModalWhyDepends (B.listMoveUp l)} (B.VtyEvent (V.EvKey V.KPageUp []), Just (ModalWhyDepends l)) -> B.listMovePageUp l >>= \l' ->@@ -161,7 +174,39 @@ in case B.listSelectedElement l of Nothing -> B.continue closed Just (_, path) -> B.continue $ selectPath path closed- -- otherwise+ -- search modal+ (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.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.VtyEvent (V.EvKey V.KLeft []), Just (ModalSearch l r xs)) ->+ B.continue+ s+ { aeOpenModal =+ Just $ ModalSearch (T.dropEnd 1 l) (T.takeEnd 1 l <> r) (B.listMoveUp xs)+ }+ (B.VtyEvent (V.EvKey V.KRight []), Just (ModalSearch l r xs)) ->+ B.continue+ s+ { aeOpenModal =+ Just $ ModalSearch (l <> T.take 1 r) (T.drop 1 r) (B.listMoveUp xs)+ }+ (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.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)) ->+ let closed = s {aeOpenModal = Nothing}+ in case B.listSelectedElement xs of+ Nothing -> B.continue closed+ Just (_, path) ->+ B.continue $+ selectPath+ (shortestPathTo (aeActualStoreEnv s) (spName path))+ closed _ -> B.continue s, B.appStartEvent = \s -> return s,@@ -172,6 +217,17 @@ (attrTerminal, B.fg V.blue) ] }+ where+ allowedSearchChars :: Set Char+ allowedSearchChars =+ Set.fromList+ ( mconcat+ [ ['a' .. 'z'],+ ['A' .. 'Z'],+ ['0' .. '9'],+ "+-.=?_"+ ]+ ) renderMainScreen :: AppEnv s -> B.Widget Widgets renderMainScreen env@AppEnv {aePrevPane, aeCurrPane, aeNextPane, aeShowInfoPane} =@@ -214,6 +270,14 @@ <> T.intercalate ", " (map storeNameToShortText immediateParents) ] +renderModal :: Text -> B.Widget a -> B.Widget a+renderModal title widget =+ widget+ & B.borderWithLabel (B.txt title)+ & B.hLimitPercent 90+ & B.vLimitPercent 60+ & B.centerLayer+ helpText :: Text helpText = T.intercalate@@ -221,27 +285,19 @@ [ "hjkl/Arrow Keys : Navigate", "q/Esc: : Quit / close modal", "w : Open why-depends mode",+ "/ : Open search mode", "i : Toggle modeline", "? : Show help" ] renderHelpModal :: B.Widget a-renderHelpModal =- B.txt helpText- & B.borderWithLabel (B.txt "Help")- & B.hLimitPercent 90- & B.vLimitPercent 60- & B.centerLayer+renderHelpModal = renderModal "Help" (B.txt helpText) renderWhyDependsModal :: B.GenericList Widgets Seq (NonEmpty (Path s)) -> B.Widget Widgets renderWhyDependsModal l =- B.renderList renderDepends True l- & B.hLimitPercent 80- & B.vLimitPercent 60- & B.borderWithLabel (B.txt "why-depends")- & B.centerLayer+ renderModal "why-depends" (B.renderList renderDepends True l) where renderDepends _ = B.txt . pathsToText@@ -263,6 +319,26 @@ & B.listMoveTo (fromMaybe 0 $ (((==) `on` fmap spName) route) `S.findIndexL` xs) }++renderSearchModal :: Text -> Text -> B.GenericList Widgets Seq (Path s) -> B.Widget Widgets+renderSearchModal left right list =+ renderModal "Search" window+ where+ window =+ B.txt left B.<+> B.txt "|" B.<+> B.txt right+ B.<=> B.hBorder+ B.<=> renderList True list++showAndUpdateSearch :: Text -> Text -> AppEnv s -> AppEnv s+showAndUpdateSearch left right env@AppEnv {aeActualStoreEnv, aeInvertedIndex} =+ env {aeOpenModal = Just $ ModalSearch left right results}+ where+ results =+ let xs =+ iiSearch (left <> right) aeInvertedIndex+ & (S.fromList . Set.toList)+ & fmap (seLookup aeActualStoreEnv . StoreName)+ in B.list WidgetSearch xs 1 move :: (List s -> List s) -> AppEnv s -> AppEnv s move f = runIdentity . moveF (Identity . f)
+ src/InvertedIndex.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE NoImplicitPrelude #-}++module InvertedIndex+ ( InvertedIndex,+ iiFromList,+ iiInsert,+ iiSearch,+ )+where++import Data.List (zip3)+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.Text as Text+import Protolude++data InvertedIndex = InvertedIndex+ { iiElems :: Set Text,+ iiUnigrams :: Map Char (Set Text),+ iiBigrams :: Map (Char, Char) (Set Text),+ iiTrigrams :: Map (Char, Char, Char) (Set Text)+ }+ deriving (Generic)++instance NFData InvertedIndex++iiInsert :: Text -> InvertedIndex -> InvertedIndex+iiInsert txt InvertedIndex {iiElems, iiUnigrams, iiBigrams, iiTrigrams} =+ InvertedIndex+ { iiElems = Set.insert txt iiElems,+ iiUnigrams = combine iiUnigrams (unigramsOf txt),+ iiBigrams = combine iiBigrams (bigramsOf txt),+ iiTrigrams = combine iiTrigrams (trigramsOf txt)+ }+ where+ combine orig chrs =+ Map.unionWith+ (<>)+ orig+ (setToMap (Set.singleton txt) chrs)++iiFromList :: [Text] -> InvertedIndex+iiFromList =+ foldl+ (flip iiInsert)+ (InvertedIndex Set.empty Map.empty Map.empty Map.empty)++setToMap :: v -> Set k -> Map k v+setToMap v = Map.fromDistinctAscList . map (,v) . Set.toAscList++unigramsOf :: Text -> Set Char+unigramsOf txt = Set.fromList $ Text.unpack txt++bigramsOf :: Text -> Set (Char, Char)+bigramsOf txt = case Text.unpack txt of+ p1@(_ : p2) -> Set.fromList $ zip p1 p2+ _ -> Set.empty++trigramsOf :: Text -> Set (Char, Char, Char)+trigramsOf txt = case Text.unpack txt of+ p1@(_ : p2@(_ : p3)) -> Set.fromList $ zip3 p1 p2 p3+ _ -> Set.empty++iiSearch :: Text -> InvertedIndex -> Set Text+iiSearch txt InvertedIndex {iiElems, iiUnigrams, iiBigrams, iiTrigrams}+ | Text.length txt == 0 = iiElems+ | Text.length txt == 1 = using unigramsOf iiUnigrams+ | Text.length txt == 2 = using bigramsOf iiBigrams+ | otherwise = using trigramsOf iiTrigrams+ where+ using :: Ord a => (Text -> Set a) -> Map a (Set Text) -> Set Text+ using getGrams m =+ Map.intersection m (setToMap () (getGrams txt))+ & Map.elems+ & \case+ [] -> Set.empty+ (x : xs) -> foldl' Set.intersection x xs
src/Main.hs view
@@ -69,6 +69,7 @@ go newRemaining (concatMap (maybe [] spRefs) foundNodes)+ _ <- forkIO $ go (sePaths env) (toList $ seRoots env) run env
src/PathStats.hs view
@@ -1,13 +1,14 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} module PathStats ( PathStats (..), calculatePathStats,- markRouteTo, whyDepends,+ shortestPathTo, module StorePath, ) where@@ -42,8 +43,8 @@ [ (spName, const () <$> sp) | sp@StorePath {spName} <- spRefs curr, pred spName- ]- : map (ipsAllRefs . spPayload) (spRefs curr)+ ] :+ map (ipsAllRefs . spPayload) (spRefs curr) ) } @@ -115,8 +116,28 @@ & concat & map NE.reverse -markRouteTo :: StoreName s -> StoreEnv s a -> StoreEnv s (Bool, a)-markRouteTo name = seBottomUp $ \sp@StorePath {spName, spRefs} ->- ( spName == name || any (fst . spPayload) spRefs,- spPayload sp- )+-- TODO: This can be precomputed.+shortestPathTo :: StoreEnv s a -> StoreName s -> NonEmpty (StorePath s (StoreName s) a)+shortestPathTo env name =+ seBottomUp+ ( \curr ->+ let currOut = curr {spRefs = spName <$> spRefs curr}+ in if spName curr == name+ then Just (1 :: Int, currOut :| [])+ else+ spRefs curr+ & fmap spPayload+ & catMaybes+ & \case+ [] -> Nothing+ xs -> case minimumBy (comparing fst) xs of+ (c, p) -> Just (c + 1, currOut NE.<| p)+ )+ env+ & seGetRoots+ & fmap spPayload+ & NE.toList+ & catMaybes+ & minimumBy (comparing fst)+ & snd+ & NE.reverse
src/StorePath.hs view
@@ -19,6 +19,7 @@ StoreEnv (..), withStoreEnv, seLookup,+ seAll, seGetRoots, seBottomUp, seFetchRefs,@@ -26,9 +27,9 @@ where import Control.Monad (fail)-import Data.Aeson ((.:), FromJSON (..), Value (..), decode)-import qualified Data.HashMap.Strict as HM+import Data.Aeson (FromJSON (..), Value (..), decode, (.:)) import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS import qualified Data.Text as T import Protolude@@ -142,6 +143,11 @@ fromMaybe (panic $ "invariant violation, StoreName not found: " <> show name) (HM.lookup name sePaths)++seAll :: StoreEnv s a -> NonEmpty (StorePath s (StoreName s) a)+seAll StoreEnv {sePaths} = case HM.elems sePaths of+ [] -> panic "invariant violation: no paths"+ (x : xs) -> x :| xs seGetRoots :: StoreEnv s a -> NonEmpty (StorePath s (StoreName s) a) seGetRoots env@StoreEnv {seRoots} =