diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog +## 0.3.3 - 2024-01-17: + +* chore: Update 'brick' & 'optparse-applicative' library to work with the newer Stackage snapshot (thanks @ncfavier, PR: [#78][]) + +[#78]: https://github.com/utdemir/nix-tree/issues/78 + ## 0.3.2 - 2023-11-28: * fix: Support new path-info syntax introduced in nix 2.19 (thanks @SuperSandro2000, @GrigorenkoPV9, issue: [#67][], PR: [#68][]) diff --git a/nix-tree.cabal b/nix-tree.cabal --- a/nix-tree.cabal +++ b/nix-tree.cabal @@ -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.3.2 +version: 0.3.3 homepage: https://github.com/utdemir/nix-tree license: BSD-3-Clause license-file: LICENSE @@ -48,7 +48,7 @@ build-depends: base , relude , aeson - , brick >= 1 && < 2 + , brick >= 2.1 && < 2.4 , bytestring , containers , clock diff --git a/src/NixTree/App.hs b/src/NixTree/App.hs --- a/src/NixTree/App.hs +++ b/src/NixTree/App.hs @@ -134,9 +134,7 @@ return () -- And run the application - let mkVty = V.mkVty V.defaultConfig - initialVty <- mkVty - _ <- B.customMain initialVty mkVty (Just chan) app appEnv + _ <- B.customMainWithDefaultVty (Just chan) app appEnv return () @@ -145,7 +143,7 @@ Bool -> List s -> B.Widget Widgets -renderList highlightSort isFocused = +renderList highlightSort = B.renderList ( \_ StorePath @@ -179,7 +177,6 @@ ] ] ) - isFocused where underlineWhen so = if Just so == highlightSort @@ -266,7 +263,7 @@ Nothing -> put closed Just (_, path) -> put $ selectPath path closed -- search modal - (B.VtyEvent (V.EvKey V.KEsc []), Just (ModalSearch _ _ _)) -> + (B.VtyEvent (V.EvKey V.KEsc []), Just (ModalSearch {})) -> put s {aeOpenModal = Nothing} (B.VtyEvent (V.EvKey k []), Just (ModalSearch l r xs)) | k `elem` [V.KDown, V.KChar '\t'] -> @@ -289,7 +286,7 @@ (B.VtyEvent (V.EvKey (V.KChar c) []), Just (ModalSearch l r _)) | c `Set.member` allowedSearchChars -> modify (showAndUpdateSearch (l <> T.singleton c) r) - (B.VtyEvent (V.EvKey (V.KBS) []), Just (ModalSearch l r _)) -> + (B.VtyEvent (V.EvKey V.KBS []), Just (ModalSearch l r _)) -> modify (showAndUpdateSearch (T.dropEnd 1 l) r) (B.VtyEvent (V.EvKey V.KEnter []), Just (ModalSearch _ _ xs)) -> let closed = s {aeOpenModal = Nothing} @@ -309,9 +306,7 @@ let new = s {aeCurrTime = t} in do put new - if timePassedSinceSortOrderChange new <= sum (replicate 2 sortOrderChangeHighlightPeriod) - then return () - else B.continueWithoutRedraw + unless (timePassedSinceSortOrderChange new <= sum (replicate 2 sortOrderChangeHighlightPeriod)) B.continueWithoutRedraw -- ignore otherwise _ -> return (), @@ -377,9 +372,8 @@ let selected = selectedPath env immediateParents = psImmediateParents $ spPayload selected in B.vBox - [ ( let (f, s) = storeNameToSplitShortText (spName selected) - in B.txt f B.<+> underlineWhen SortOrderAlphabetical (B.txt s) - ), + [ let (f, s) = storeNameToSplitShortText (spName selected) + in B.txt f B.<+> underlineWhen SortOrderAlphabetical (B.txt s), [ B.txt $ "NAR Size: " <> prettySize (spSize selected), underlineWhen SortOrderClosureSize . B.txt $ "Closure Size: " <> prettySize (psTotalSize $ spPayload selected), underlineWhen SortOrderAddedSize . B.txt $ "Added Size: " <> prettySize (psAddedSize $ spPayload selected) @@ -456,7 +450,7 @@ xs = S.fromList $ whyDepends aeActualStoreEnv (spName selected) in B.list WidgetWhyDepends xs 1 & B.listMoveTo - (fromMaybe 0 $ (((==) `on` fmap spName) route) `S.findIndexL` xs) + (fromMaybe 0 $ ((==) `on` fmap spName) route `S.findIndexL` xs) } renderSearchModal :: Text -> Text -> B.GenericList Widgets Seq (Path s) -> B.Widget Widgets @@ -467,8 +461,8 @@ B.txt left B.<+> B.txt "|" B.<+> B.txt right - B.<=> B.hBorder - B.<=> renderList Nothing True l + B.<=> B.hBorder + B.<=> renderList Nothing True l showAndUpdateSearch :: Text -> Text -> AppEnv s -> AppEnv s showAndUpdateSearch left right env@AppEnv {aeInvertedIndex} = @@ -600,7 +594,7 @@ let contents = S.sortBy (compareBySortOrder sortOrder) possible in B.list name contents 1 & B.listMoveTo - (fromMaybe 0 $ selected >>= \s -> (((==) `on` spName) s) `S.findIndexL` contents) + (fromMaybe 0 $ selected >>= \s -> ((==) `on` spName) s `S.findIndexL` contents) -- Utils diff --git a/src/NixTree/Main.hs b/src/NixTree/Main.hs --- a/src/NixTree/Main.hs +++ b/src/NixTree/Main.hs @@ -8,7 +8,7 @@ import NixTree.PathStats import qualified Options.Applicative as Opts import qualified Options.Applicative.Help.Pretty as Opts -import System.Directory (doesDirectoryExist, getHomeDirectory) +import System.Directory (XdgDirectory (XdgState), doesDirectoryExist, getHomeDirectory, getXdgDirectory) import System.Exit (ExitCode (..)) import System.FilePath (()) import System.IO (hPutStrLn) @@ -42,8 +42,10 @@ ( Opts.metavar "INSTALLABLE" <> Opts.helpDoc ( Just $ - "A store path or a flake reference." - Opts.<$$> "Paths default to \"~/.nix-profile\" and \"/var/run/current-system\"" + Opts.vsep + [ "A store path or a flake reference.", + "Paths default to \"~/.nix-profile\" and \"/var/run/current-system\"" + ] ) ) ) @@ -53,8 +55,10 @@ keybindingsHelp :: Opts.Doc keybindingsHelp = - "Keybindings:" - Opts.<$$> (Opts.indent 2 . Opts.vsep $ map (Opts.text . toString) (lines helpText)) + Opts.vsep + [ "Keybindings:", + Opts.indent 2 . Opts.vsep $ map Opts.pretty (lines helpText) + ] showAndFail :: Text -> IO a showAndFail msg = do @@ -70,17 +74,19 @@ when (opts & oVersion) $ do putTextLn $ "nix-tree " <> version - exitWith ExitSuccess + exitSuccess installables <- case opts & oInstallables of p : ps -> return $ p :| ps [] -> do home <- getHomeDirectory + nixXdgDirectory <- getXdgDirectory XdgState "nix/profile" roots <- filterM doesDirectoryExist [ home ".nix-profile", + nixXdgDirectory, "/var/run/current-system" ] case roots of diff --git a/src/NixTree/PathStats.hs b/src/NixTree/PathStats.hs --- a/src/NixTree/PathStats.hs +++ b/src/NixTree/PathStats.hs @@ -34,7 +34,7 @@ { ipsAllRefs = M.unions ( M.fromList - [ (spName, const () <$> sp) + [ (spName, void sp) | sp@StorePath {spName} <- spRefs curr, env spName ] @@ -68,7 +68,7 @@ ( \sp@StorePath {spName, spPayload} -> M.insert spName - (const () <$> sp) + (void sp) (ipsAllRefs spPayload) ) & M.unions @@ -85,7 +85,7 @@ M.unionWith (<>) m - (M.fromList (map (\r -> (r, S.singleton spName)) spRefs)) + (M.fromList (map (,S.singleton spName) spRefs)) ) M.empty @@ -101,9 +101,7 @@ in if spName curr == name then Just (1 :: Int, currOut :| []) else - spRefs curr - & fmap spPayload - & catMaybes + mapMaybe spPayload (spRefs curr) & \case [] -> Nothing xs -> case minimumBy (comparing fst) xs of @@ -130,9 +128,7 @@ if spName curr == name then Just $ mkTreeish (curr {spRefs = map spName (spRefs curr)}) [] else - spRefs curr - & map spPayload - & catMaybes + mapMaybe spPayload (spRefs curr) & NE.nonEmpty <&> NE.toList <&> mkTreeish (curr {spRefs = map spName (spRefs curr)}) diff --git a/src/NixTree/StorePath.hs b/src/NixTree/StorePath.hs --- a/src/NixTree/StorePath.hs +++ b/src/NixTree/StorePath.hs @@ -19,7 +19,7 @@ ) where -import Data.Aeson (FromJSON (..), Object, Value (..), decode, (.:)) +import Data.Aeson (FromJSON (..), Value (..), decode, (.:)) import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import Data.Aeson.Types (Parser) @@ -54,7 +54,8 @@ args = ["--eval", "--expr", "(builtins.storeDir)", "--json"] out <- readProcessStdout_ (proc prog args) - <&> fmap mkNixStore . decode @FilePath + <&> fmap mkNixStore + . decode @FilePath case out of Nothing -> fail $ "Error interpreting output of: " ++ show (prog, args) Just p -> return p @@ -156,9 +157,9 @@ ( proc "nix" ( ["path-info", "--json"] - ++ (if options & pioIsImpure then ["--impure"] else []) - ++ (if options & pioIsRecursive then ["--recursive"] else []) - ++ (if (options & pioIsDerivation) && nixVersion >= Nix2_4 then ["--derivation"] else []) + ++ ["--impure" | options & pioIsImpure] + ++ ["--recursive" | options & pioIsRecursive] + ++ ["--derivation" | (options & pioIsDerivation) && nixVersion >= Nix2_4] ++ (if nixVersion >= Nix2_4 then ["--extra-experimental-features", "nix-command flakes"] else []) ++ map (toString . installableToText) (toList names) ) @@ -311,12 +312,7 @@ sp@StorePath {spName, spRefs} <- unsafeLookup name <$> gets fst refs <- mapM go spRefs let new = sp {spPayload = f sp {spRefs = refs}} - modify - ( \(as, bs) -> - ( HM.delete spName as, - HM.insert spName new bs - ) - ) + modify $ bimap (HM.delete spName) (HM.insert spName new) return new -------------------------------------------------------------------------------- @@ -331,38 +327,39 @@ = NixPathInfoValid NixPathInfo | NixPathInfoInvalid FilePath -instance FromJSON NixPathInfoResult where - parseJSON (Object obj) = - ( NixPathInfoValid - <$> ( NixPathInfo - <$> obj .: "path" - <*> obj .: "narSize" - <*> obj .: "references" - ) - ) - <|> ( do - path <- obj .: "path" - valid <- obj .: "valid" - guard (not valid) - return $ NixPathInfoInvalid path +parse2_18 :: Value -> Parser NixPathInfoResult +parse2_18 (Object obj) = + ( NixPathInfoValid + <$> ( NixPathInfo + <$> obj .: "path" + <*> obj .: "narSize" + <*> obj .: "references" ) - parseJSON _ = fail "Expecting an object." + ) + <|> ( do + path <- obj .: "path" + valid <- obj .: "valid" + guard (not valid) + return $ NixPathInfoInvalid path + ) +parse2_18 _ = fail "Expecting an object." +parse2_19 :: (FilePath, Value) -> Parser NixPathInfoResult +parse2_19 (path, Object obj) = + NixPathInfoValid + <$> ( NixPathInfo + path + <$> obj .: "narSize" + <*> obj .: "references" + ) +parse2_19 (path, Null) = return $ NixPathInfoInvalid path +parse2_19 (_, _) = fail "Expecting an object or null" + newtype NixPathOutput = NixPathOutput { npoResults :: [NixPathInfoResult] } -obj2LegacyArray :: Object -> Parser [Value] -obj2LegacyArray obj = mapM ((Object <$>) . addPathKey) (KM.toList obj) - where - addPathKey :: (K.Key, Value) -> Parser Object - addPathKey (key, Object info) = return $ KM.insert "path" (String $ K.toText key) info - addPathKey (_, _) = fail "Expecting an object" - instance FromJSON NixPathOutput where - parseJSON (Array a) = NixPathOutput <$> mapM parseJSON (toList a) - parseJSON (Object o) = do - legacyArray <- obj2LegacyArray o - result <- mapM parseJSON legacyArray - return $ NixPathOutput result + parseJSON (Array a) = NixPathOutput <$> mapM parse2_18 (toList a) + parseJSON (Object o) = NixPathOutput <$> mapM (parse2_19 . first K.toString) (KM.toList o) parseJSON _ = fail "Expecting an array (nix<=2.18) or an object with mapping from path to info (nix>=2.19)."