nix-tree 0.1.5 → 0.1.6
raw patch · 6 files changed
+88/−42 lines, 6 files
Files
- CHANGELOG.md +5/−0
- nix-tree.cabal +1/−1
- src/App.hs +22/−7
- src/InvertedIndex.hs +12/−11
- src/StorePath.hs +39/−17
- test/Test.hs +9/−6
CHANGELOG.md view
@@ -2,6 +2,11 @@ ## Unreleased +## 0.1.6++* feat: Support non standard Nix store locations+* feat: Horizontal scrolling on why-depends window+ ## 0.1.5 * feat: Add sort order toggle.
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.1.5+version: 0.1.6 homepage: https://github.com/utdemir/nix-tree license: BSD-3-Clause license-file: LICENSE
src/App.hs view
@@ -6,6 +6,7 @@ import qualified Brick.Widgets.Center as B import qualified Brick.Widgets.List as B import qualified Data.List.NonEmpty as NE+import qualified Data.Map as Map import qualified Data.Sequence as S import qualified Data.Set as Set import qualified Data.Text as T@@ -24,6 +25,7 @@ | WidgetNextPane | WidgetWhyDepends | WidgetSearch+ | WidgetWhyDependsViewport deriving (Show, Eq, Ord) data Modal s@@ -38,7 +40,7 @@ data AppEnv s = AppEnv { aeActualStoreEnv :: StoreEnv s (PathStats s),- aeInvertedIndex :: InvertedIndex,+ aeInvertedIndex :: InvertedIndex (Path s), aePrevPane :: List s, aeCurrPane :: List s, aeNextPane :: List s,@@ -71,7 +73,7 @@ run :: StoreEnv s (PathStats s) -> IO () run env = do -- Create the inverted index, and start evaluating it in the background- let ii = iiFromList . toList . map (storeNameToText . spName) $ seAll env+ let ii = iiFromList . toList . map (\sp -> (storeNameToText (spName sp), sp)) $ seAll env _ <- forkIO $ evaluate (rnf ii) -- Initial state@@ -189,7 +191,8 @@ B.halt s (B.VtyEvent (V.EvKey (V.KChar '?') []), Nothing) -> B.continue s {aeOpenModal = Just ModalHelp}- (B.VtyEvent (V.EvKey (V.KChar 'w') []), Nothing) ->+ (B.VtyEvent (V.EvKey (V.KChar 'w') []), Nothing) -> do+ B.hScrollToBeginning (B.viewportScroll WidgetWhyDependsViewport) B.continue $ showWhyDepends s (B.VtyEvent (V.EvKey (V.KChar '/') []), Nothing) -> B.continue $ showAndUpdateSearch "" "" s@@ -220,12 +223,20 @@ (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends _)) | k `elem` [V.KChar 'q', V.KEsc] -> 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.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.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.VtyEvent (V.EvKey k []), Just (ModalWhyDepends _))+ | k `elem` [V.KChar 'l', V.KRight] -> do+ 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'}@@ -376,7 +387,11 @@ B.GenericList Widgets Seq (NonEmpty (Path s)) -> B.Widget Widgets renderWhyDependsModal l =- renderModal "why-depends" (B.renderList renderDepends True l)+ B.renderList renderDepends True l+ & B.hLimitPercent 100 -- This limit seems pointless, but otherwise render list takes infinite+ -- amount of horizontal space and 'viewport' below complains.+ & B.viewport WidgetWhyDependsViewport B.Horizontal+ & renderModal "why-depends" where renderDepends _ = B.txt . pathsToText@@ -409,14 +424,14 @@ B.<=> renderList Nothing True l showAndUpdateSearch :: Text -> Text -> AppEnv s -> AppEnv s-showAndUpdateSearch left right env@AppEnv {aeActualStoreEnv, aeInvertedIndex} =+showAndUpdateSearch left right env@AppEnv {aeInvertedIndex} = env {aeOpenModal = Just $ ModalSearch left right results} where results = let xs = iiSearch (left <> right) aeInvertedIndex- & (S.fromList . Set.toList)- & fmap (seLookup aeActualStoreEnv . StoreName)+ & Map.elems+ & S.fromList in B.list WidgetSearch xs 1 move :: (List s -> List s) -> AppEnv s -> AppEnv s
src/InvertedIndex.hs view
@@ -11,20 +11,20 @@ import qualified Data.Set as Set import qualified Data.Text as Text -data InvertedIndex = InvertedIndex- { iiElems :: Set Text,+data InvertedIndex a = InvertedIndex+ { iiElems :: Map Text a, iiUnigrams :: Map Char (Set Text), iiBigrams :: Map (Char, Char) (Set Text), iiTrigrams :: Map (Char, Char, Char) (Set Text) } deriving (Generic, Show) -instance NFData InvertedIndex+instance NFData a => NFData (InvertedIndex a) -iiInsert :: Text -> InvertedIndex -> InvertedIndex-iiInsert txt InvertedIndex {iiElems, iiUnigrams, iiBigrams, iiTrigrams} =+iiInsert :: Text -> a -> InvertedIndex a -> InvertedIndex a+iiInsert txt val InvertedIndex {iiElems, iiUnigrams, iiBigrams, iiTrigrams} = InvertedIndex- { iiElems = Set.insert txt iiElems,+ { iiElems = Map.insert txt val iiElems, iiUnigrams = combine iiUnigrams (unigramsOf txt), iiBigrams = combine iiBigrams (bigramsOf txt), iiTrigrams = combine iiTrigrams (trigramsOf txt)@@ -36,11 +36,11 @@ orig (setToMap (Set.singleton txt) chrs) -iiFromList :: Foldable f => f Text -> InvertedIndex+iiFromList :: Foldable f => f (Text, a) -> InvertedIndex a iiFromList = foldl- (flip iiInsert)- (InvertedIndex Set.empty Map.empty Map.empty Map.empty)+ (flip (uncurry iiInsert))+ (InvertedIndex Map.empty Map.empty Map.empty Map.empty) setToMap :: v -> Set k -> Map k v setToMap v = Map.fromDistinctAscList . map (,v) . Set.toAscList@@ -58,7 +58,7 @@ p1@(_ : p2@(_ : p3)) -> Set.fromList $ zip3 p1 p2 p3 _ -> Set.empty -iiSearch :: Text -> InvertedIndex -> Set Text+iiSearch :: forall a. Text -> InvertedIndex a -> Map Text a iiSearch txt InvertedIndex {iiElems, iiUnigrams, iiBigrams, iiTrigrams} | Text.length txt == 0 = iiElems | Text.length txt == 1 = using unigramsOf iiUnigrams@@ -66,7 +66,7 @@ | otherwise = using trigramsOf iiTrigrams where lowerTxt = Text.toLower txt- using :: Ord a => (Text -> Set a) -> Map a (Set Text) -> Set Text+ using :: Ord c => (Text -> Set c) -> Map c (Set Text) -> Map Text a using getGrams m = Map.intersection m (setToMap () (getGrams txt)) & Map.elems@@ -74,3 +74,4 @@ [] -> Set.empty x : xs -> foldl' Set.intersection x xs & Set.filter (\t -> lowerTxt `Text.isInfixOf` Text.toLower t)+ & Map.restrictKeys iiElems
src/StorePath.hs view
@@ -12,6 +12,8 @@ seGetRoots, seBottomUp, seFetchRefs,+ getNixStore,+ mkStoreName, ) where @@ -24,25 +26,42 @@ import Data.List (partition) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T-import System.FilePath.Posix (splitDirectories)+import System.FilePath.Posix (addTrailingPathSeparator, splitDirectories, (</>)) import System.Process.Typed (proc, readProcessStdout_) +newtype NixStore = NixStore FilePath+ deriving newtype (Show, Eq, Ord, NFData, Hashable)++getNixStore :: IO NixStore+getNixStore = do+ let prog = "nix-instantiate"+ args = ["--eval", "--expr", "(builtins.storeDir)", "--json"]+ out <-+ readProcessStdout_ (proc prog args)+ <&> fmap addTrailingPathSeparator . decode @FilePath+ <&> fmap NixStore+ case out of+ Nothing -> fail $ "Error interpreting output of: " ++ show (prog, args)+ Just p -> return p+ -------------------------------------------------------------------------------- -newtype StoreName s = StoreName Text- deriving newtype (Show, Eq, Ord, Hashable, NFData)+data StoreName s = StoreName NixStore Text+ deriving stock (Show, Eq, Ord, Generic)+ deriving anyclass (NFData, Hashable) -mkStoreName :: FilePath -> Maybe (StoreName a)-mkStoreName path =- case splitDirectories path of- "/" : "nix" : "store" : name : _ -> Just . StoreName $ toS name- _ -> Nothing+mkStoreName :: NixStore -> FilePath -> Maybe (StoreName a)+mkStoreName ns@(NixStore ps) path = do+ guard $ ps `isPrefixOf` path+ let ds = splitDirectories (drop (length ps) path)+ sn <- listToMaybe ds+ return $ StoreName ns (toS sn) storeNameToText :: StoreName a -> Text-storeNameToText (StoreName n) = n+storeNameToText (StoreName _ n) = n storeNameToPath :: StoreName a -> FilePath-storeNameToPath (StoreName sn) = "/nix/store/" <> toS sn+storeNameToPath (StoreName (NixStore ns) sn) = ns </> toS sn storeNameToShortText :: StoreName a -> Text storeNameToShortText = snd . storeNameToSplitShortText@@ -67,6 +86,7 @@ mkStorePaths :: NonEmpty (StoreName s) -> IO [StorePath s (StoreName s) ()] mkStorePaths names = do+ nixStore <- getNixStore -- See: https://github.com/utdemir/nix-tree/issues/12 -- -- > In Nix < 2.4, when you pass a .drv to path-info, it returns information about the store@@ -79,16 +99,16 @@ (\i -> ".drv" `T.isSuffixOf` storeNameToText i) (NE.toList names) (++)- <$> maybe (return []) (getPathInfo False) (NE.nonEmpty outputs)- <*> maybe (return []) (getPathInfo (True && isAtLeastNix24)) (NE.nonEmpty derivations)+ <$> maybe (return []) (getPathInfo nixStore False) (NE.nonEmpty outputs)+ <*> maybe (return []) (getPathInfo nixStore (True && isAtLeastNix24)) (NE.nonEmpty derivations) where getNixVersion :: IO (Maybe Text) getNixVersion = do out <- decodeUtf8 . BL.toStrict <$> readProcessStdout_ (proc "nix" ["--version"]) return . lastMay $ T.splitOn " " out -getPathInfo :: Bool -> NonEmpty (StoreName s) -> IO [StorePath s (StoreName s) ()]-getPathInfo isDrv names = do+getPathInfo :: NixStore -> Bool -> NonEmpty (StoreName s) -> IO [StorePath s (StoreName s) ()]+getPathInfo nixStore isDrv names = do infos <- decode @[NixPathInfoResult] <$> readProcessStdout_@@ -117,11 +137,11 @@ maybe (fail $ "Failed parsing Nix store path: " ++ show p) return- (mkStoreName p)+ (mkStoreName nixStore p) assertValidInfo (NixPathInfoValid pathinfo) = return pathinfo assertValidInfo (NixPathInfoInvalid path) =- fail $ "Invalid path: " ++ path ++ ". Inconsistent /nix/store or ongoing GC."+ fail $ "Invalid path: " ++ path ++ ". Inconsistent NIX_STORE or ongoing GC." -------------------------------------------------------------------------------- @@ -138,10 +158,12 @@ (forall s. StoreEnv s () -> m a) -> m (Either [FilePath] a) withStoreEnv fnames cb = do+ nixStore <- liftIO getNixStore+ let names' = fnames & toList- & map (\f -> maybe (Left f) Right (mkStoreName f))+ & map (\f -> maybe (Left f) Right (mkStoreName nixStore f)) & partitionEithers case names' of
test/Test.hs view
@@ -2,7 +2,7 @@ module Main where -import qualified Data.Set as Set+import qualified Data.Map as Map import qualified Data.Text as Text import Hedgehog import qualified Hedgehog.Gen as Gen@@ -14,21 +14,24 @@ prop_inverted_index = withDiscards 10000 . withTests 10000 . property $ do haystack <- forAll $- Gen.set+ Gen.map (Range.linear 0 100)- (Gen.text (Range.linear 0 10) Gen.alphaNum)+ ( (,)+ <$> Gen.text (Range.linear 0 10) Gen.alphaNum+ <*> Gen.int (Range.linear 0 100)+ ) needle <- forAll $ (Gen.text (Range.linear 0 5) Gen.alphaNum) - let ii = iiFromList haystack+ let ii = iiFromList (Map.toList haystack) annotateShow ii let expected = haystack- & Set.filter- (\t -> Text.toLower needle `Text.isInfixOf` Text.toLower t)+ & Map.filterWithKey+ (\t _ -> Text.toLower needle `Text.isInfixOf` Text.toLower t) actual = iiSearch needle ii expected === actual