nix-tree 0.1.3.1 → 0.1.4
raw patch · 7 files changed
+122/−83 lines, 7 filesdep +hedgehogdep −asyncdep −lensdep −paralleldep ~base
Dependencies added: hedgehog
Dependencies removed: async, lens, parallel
Dependency ranges changed: base
Files
- nix-tree.cabal +46/−11
- src/App.hs +8/−10
- src/InvertedIndex.hs +8/−14
- src/Main.hs +0/−6
- src/PathStats.hs +4/−11
- src/StorePath.hs +19/−31
- test/Test.hs +37/−0
nix-tree.cabal view
@@ -1,31 +1,52 @@+cabal-version: 2.4+ 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.3.1+version: 0.1.4 homepage: https://github.com/utdemir/nix-tree-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Utku Demir maintainer: Utku Demir copyright: Utku Demir category: Language.Nix build-type: Simple-cabal-version: >=1.10 extra-source-files: README.md -executable nix-tree- main-is: Main.hs- hs-source-dirs: src+common common-options+ ghc-options: -threaded+ -Wall -Wpartial-fields -Wincomplete-record-updates -Widentities+ -Wunused-packages default-language: Haskell2010+ default-extensions: LambdaCase+ OverloadedStrings+ TupleSections+ TypeApplications+ GeneralizedNewtypeDeriving+ DeriveGeneric+ DeriveFunctor+ DerivingStrategies+ DeriveAnyClass+ FlexibleInstances+ DeriveLift+ StandaloneDeriving+ DataKinds+ KindSignatures+ NamedFieldPuns+ RankNTypes+ ScopedTypeVariables other-modules: PathStats StorePath App InvertedIndex Paths_nix_tree- ghc-options: -Wall -fno-warn-name-shadowing -threaded -threaded- build-depends: base >= 4.11 && < 5+ autogen-modules: Paths_nix_tree+ mixins: base hiding (Prelude)+ , protolude (Protolude as Prelude)+ build-depends: base+ , protolude , aeson- , async , brick , bytestring , containers@@ -34,11 +55,25 @@ , filepath , hashable , hrfsize- , lens- , parallel , protolude , text , transformers , typed-process , unordered-containers , vty++executable nix-tree+ import: common-options+ main-is: Main.hs+ hs-source-dirs: src+ default-language: Haskell2010+ build-depends: base >= 4.11 && < 5++test-suite nix-tree-tests+ import: common-options+ type: exitcode-stdio-1.0+ hs-source-dirs: test/ src/+ main-is: Test.hs+ ghc-options: -Wno-unused-packages+ build-depends: base >=4.11 && < 5+ , hedgehog
src/App.hs view
@@ -1,8 +1,3 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoImplicitPrelude #-}- module App (run, helpText) where import qualified Brick as B@@ -16,7 +11,6 @@ import qualified Graphics.Vty as V import InvertedIndex import PathStats-import Protolude import qualified System.HrfSize as HRF data Widgets@@ -81,7 +75,7 @@ Bool -> List s -> B.Widget Widgets-renderList isFocused list =+renderList isFocused = B.renderList ( \_ StorePath@@ -108,7 +102,6 @@ ) ) isFocused- list app :: B.App (AppEnv s) () Widgets app =@@ -208,6 +201,11 @@ selectPath (shortestPathTo (aeActualStoreEnv s) (spName path)) closed+ -- help modal+ (B.VtyEvent (V.EvKey k []), Just ModalHelp)+ | k `elem` [V.KChar 'q', V.KEsc] ->+ B.continue s {aeOpenModal = Nothing}+ -- ignore otherwise _ -> B.continue s, B.appStartEvent = \s -> return s,@@ -322,13 +320,13 @@ } renderSearchModal :: Text -> Text -> B.GenericList Widgets Seq (Path s) -> B.Widget Widgets-renderSearchModal left right list =+renderSearchModal left right l = renderModal "Search" window where window = B.txt left B.<+> B.txt "|" B.<+> B.txt right B.<=> B.hBorder- B.<=> renderList True list+ B.<=> renderList True l showAndUpdateSearch :: Text -> Text -> AppEnv s -> AppEnv s showAndUpdateSearch left right env@AppEnv {aeActualStoreEnv, aeInvertedIndex} =
src/InvertedIndex.hs view
@@ -1,10 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE NoImplicitPrelude #-}- module InvertedIndex ( InvertedIndex, iiFromList,@@ -17,7 +10,6 @@ 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,@@ -25,7 +17,7 @@ iiBigrams :: Map (Char, Char) (Set Text), iiTrigrams :: Map (Char, Char, Char) (Set Text) }- deriving (Generic)+ deriving (Generic, Show) instance NFData InvertedIndex @@ -44,7 +36,7 @@ orig (setToMap (Set.singleton txt) chrs) -iiFromList :: [Text] -> InvertedIndex+iiFromList :: Foldable f => f Text -> InvertedIndex iiFromList = foldl (flip iiInsert)@@ -54,15 +46,15 @@ setToMap v = Map.fromDistinctAscList . map (,v) . Set.toAscList unigramsOf :: Text -> Set Char-unigramsOf txt = Set.fromList $ Text.unpack txt+unigramsOf = Set.fromList . Text.unpack . Text.toLower bigramsOf :: Text -> Set (Char, Char)-bigramsOf txt = case Text.unpack txt of+bigramsOf txt = case Text.unpack (Text.toLower txt) of p1@(_ : p2) -> Set.fromList $ zip p1 p2 _ -> Set.empty trigramsOf :: Text -> Set (Char, Char, Char)-trigramsOf txt = case Text.unpack txt of+trigramsOf txt = case Text.unpack (Text.toLower txt) of p1@(_ : p2@(_ : p3)) -> Set.fromList $ zip3 p1 p2 p3 _ -> Set.empty @@ -73,10 +65,12 @@ | Text.length txt == 2 = using bigramsOf iiBigrams | otherwise = using trigramsOf iiTrigrams where+ lowerTxt = Text.toLower txt 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+ x : xs -> foldl' Set.intersection x xs+ & Set.filter (\t -> lowerTxt `Text.isInfixOf` Text.toLower t)
src/Main.hs view
@@ -1,8 +1,3 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoImplicitPrelude #-}- module Main where import App@@ -10,7 +5,6 @@ import Data.Version (showVersion) import PathStats import Paths_nix_tree (version)-import Protolude import System.Directory (canonicalizePath, doesDirectoryExist, getHomeDirectory) import System.FilePath ((</>))
src/PathStats.hs view
@@ -1,9 +1,3 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE NoImplicitPrelude #-}- module PathStats ( PathStats (..), calculatePathStats,@@ -16,7 +10,6 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Map.Lazy as M import qualified Data.Set as S-import Protolude import StorePath data IntermediatePathStats s = IntermediatePathStats@@ -34,7 +27,7 @@ (StoreName s -> Bool) -> StoreEnv s () -> StoreEnv s (IntermediatePathStats s)-mkIntermediateEnv pred =+mkIntermediateEnv env = seBottomUp $ \curr -> IntermediatePathStats { ipsAllRefs =@@ -42,7 +35,7 @@ ( M.fromList [ (spName, const () <$> sp) | sp@StorePath {spName} <- spRefs curr,- pred spName+ env spName ] : map (ipsAllRefs . spPayload) (spRefs curr) )@@ -67,8 +60,8 @@ } where calculateEnvSize :: StoreEnv s (IntermediatePathStats s) -> Int- calculateEnvSize env =- seGetRoots env+ calculateEnvSize e =+ seGetRoots e & toList & map ( \sp@StorePath {spName, spPayload} ->
src/StorePath.hs view
@@ -1,15 +1,3 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE NoImplicitPrelude #-}- module StorePath ( StoreName (..), storeNameToPath,@@ -35,7 +23,6 @@ import Data.List (partition) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T-import Protolude import System.FilePath.Posix (splitDirectories) import System.Process.Typed (proc, readProcessStdout_) @@ -93,22 +80,22 @@ 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- infos <-- decode @[NixPathInfoResult]- <$> readProcessStdout_- ( proc- "nix"- ( ["path-info", "--recursive", "--json"]- ++ (if isDrv then ["--derivation"] else [])- ++ map storeNameToPath (toList names)- )+getPathInfo :: Bool -> NonEmpty (StoreName s) -> IO [StorePath s (StoreName s) ()]+getPathInfo isDrv names = do+ infos <-+ decode @[NixPathInfoResult]+ <$> readProcessStdout_+ ( proc+ "nix"+ ( ["path-info", "--recursive", "--json"]+ ++ (if isDrv then ["--derivation"] else [])+ ++ map storeNameToPath (toList names) )- >>= maybe (fail "Failed parsing nix path-info output.") return- >>= mapM assertValidInfo- mapM infoToStorePath infos-+ )+ >>= maybe (fail "Failed parsing nix path-info output.") return+ >>= mapM assertValidInfo+ mapM infoToStorePath infos+ where infoToStorePath NixPathInfo {npiPath, npiNarSize, npiReferences} = do name <- mkStoreNameIO npiPath refs <- filter (/= name) <$> mapM mkStoreNameIO npiReferences@@ -124,7 +111,8 @@ (fail $ "Failed parsing Nix store path: " ++ show p) return (mkStoreName p)- assertValidInfo (NixPathInfoValid pi) = return pi++ assertValidInfo (NixPathInfoValid pathinfo) = return pathinfo assertValidInfo (NixPathInfoInvalid path) = fail $ "Invalid path: " ++ path ++ ". Inconsistent /nix/store or ongoing GC." @@ -223,8 +211,8 @@ ) (StorePath s (StoreName s) b) go name = do- bs <- gets snd- case name `HM.lookup` bs of+ processed <- gets snd+ case name `HM.lookup` processed of Just sp -> return sp Nothing -> do sp@StorePath {spName, spRefs} <- unsafeLookup name <$> gets fst
+ test/Test.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TemplateHaskell #-}++module Main where++import qualified Data.Set as Set+import qualified Data.Text as Text+import Hedgehog+import qualified Hedgehog.Gen as Gen+import Hedgehog.Main+import qualified Hedgehog.Range as Range+import InvertedIndex++prop_inverted_index :: Property+prop_inverted_index = withDiscards 10000 . withTests 10000 . property $ do+ haystack <-+ forAll $+ Gen.set+ (Range.linear 0 100)+ (Gen.text (Range.linear 0 10) Gen.alphaNum)++ needle <-+ forAll $+ (Gen.text (Range.linear 0 5) Gen.alphaNum)++ let ii = iiFromList haystack+ annotateShow ii++ let expected =+ haystack+ & Set.filter+ (\t -> Text.toLower needle `Text.isInfixOf` Text.toLower t)+ actual = iiSearch needle ii++ expected === actual++main :: IO ()+main = defaultMain [checkParallel $$(discover)]