Skip to content

Commit 3dd4e4e

Browse files
utdemirutdemir
committed
Disambiguate paths with the same name
1 parent c77eccc commit 3dd4e4e

File tree

3 files changed

+135
-78
lines changed

3 files changed

+135
-78
lines changed

‎src/NixTree/App.hs

Lines changed: 28 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -38,30 +38,30 @@ data Notice = Notice Text Text
3838

3939
data Modal s
4040
= ModalNotice Notice
41-
| ModalWhyDepends (B.GenericList Widgets Seq (NonEmpty (Path s)))
42-
| ModalSearch Text Text (B.GenericList Widgets Seq (Path s))
41+
| ModalWhyDepends (B.GenericList Widgets Seq (NonEmpty Path))
42+
| ModalSearch Text Text (B.GenericList Widgets Seq Path)
4343

4444
succCycle :: forall a. (Bounded a, Enum a) => a -> a
4545
succCycle a
4646
| fromEnum a == fromEnum (maxBound @a) = minBound
4747
| otherwise = succ a
4848

4949
data AppEnv s = AppEnv
50-
{ aeActualStoreEnv :: StoreEnv s (PathStats s),
51-
aeInvertedIndex :: InvertedIndex (Path s),
52-
aePrevPane :: List s,
53-
aeCurrPane :: List s,
54-
aeNextPane :: List s,
55-
aeParents :: [List s],
50+
{ aeActualStoreEnv :: StoreEnv PathStats,
51+
aeInvertedIndex :: InvertedIndex Path,
52+
aePrevPane :: List,
53+
aeCurrPane :: List,
54+
aeNextPane :: List,
55+
aeParents :: [List],
5656
aeOpenModal :: Maybe (Modal s),
5757
aeSortOrder :: SortOrder,
5858
aeSortOrderLastChanged :: Clock.TimeSpec,
5959
aeCurrTime :: Clock.TimeSpec
6060
}
6161

62-
type Path s = StorePath s (StoreName s) (PathStats s)
62+
type Path = StorePath StoreName PathStats
6363

64-
type List s = B.GenericList Widgets Seq (Path s)
64+
type List = B.GenericList Widgets Seq Path
6565

6666
data SortOrder
6767
= SortOrderAlphabetical
@@ -71,12 +71,12 @@ data SortOrder
7171

7272
B.suffixLenses ''AppEnv
7373

74-
_ModalWhyDepends :: Traversal' (Modal s) (B.GenericList Widgets Seq (NonEmpty (Path s)))
74+
_ModalWhyDepends :: Traversal' (Modal s) (B.GenericList Widgets Seq (NonEmpty Path))
7575
_ModalWhyDepends f m = case m of
7676
ModalWhyDepends l -> ModalWhyDepends <$> f l
7777
_ -> pure m
7878

79-
compareBySortOrder :: SortOrder -> Path s -> Path s -> Ordering
79+
compareBySortOrder :: SortOrder -> Path -> Path -> Ordering
8080
compareBySortOrder SortOrderAlphabetical = compare `on` T.toLower . storeNameToShortText . spName
8181
compareBySortOrder SortOrderClosureSize = compare `on` Down . psTotalSize . spPayload
8282
compareBySortOrder SortOrderAddedSize = compare `on` Down . psAddedSize . spPayload
@@ -85,7 +85,7 @@ attrTerminal, attrUnderlined :: B.AttrName
8585
attrTerminal = B.attrName "terminal"
8686
attrUnderlined = B.attrName "underlined"
8787

88-
run :: StoreEnv s (PathStats s) -> IO ()
88+
run :: StoreEnv PathStats -> IO ()
8989
run env = do
9090
-- Create the inverted index, and start evaluating it in the background
9191
let ii = iiFromList . toList . fmap (\sp -> (storeNameToText (spName sp), sp)) $ seAll env
@@ -142,14 +142,14 @@ run env = do
142142
renderList ::
143143
Maybe SortOrder ->
144144
Bool ->
145-
List s ->
145+
List ->
146146
B.Widget Widgets
147147
renderList highlightSort =
148148
B.renderList
149149
( \_
150150
StorePath
151151
{ spName,
152-
spPayload = PathStats {psTotalSize, psAddedSize},
152+
spPayload = PathStats {psTotalSize, psAddedSize, psDisambiguationChars},
153153
spRefs,
154154
spSignatures
155155
} ->
@@ -162,7 +162,7 @@ renderList highlightSort =
162162
[ if null spSignatures
163163
then B.txt " "
164164
else B.txt "✓ ",
165-
B.txt (storeNameToShortText spName)
165+
B.txt (storeNameToShortTextWithDisambiguation psDisambiguationChars spName)
166166
& underlineWhen SortOrderAlphabetical
167167
& B.padRight (B.Pad 1)
168168
& B.padRight B.Max,
@@ -336,7 +336,7 @@ app =
336336
]
337337
)
338338

339-
yankToClipboard :: StoreName s -> IO (Either Notice ())
339+
yankToClipboard :: StoreName -> IO (Either Notice ())
340340
yankToClipboard p =
341341
Clipboard.copy (toText $ storeNameToPath p)
342342
<&> \case
@@ -438,7 +438,7 @@ renderNotice :: Notice -> B.Widget a
438438
renderNotice (Notice title txt) = renderModal title (B.txt txt)
439439

440440
renderWhyDependsModal ::
441-
B.GenericList Widgets Seq (NonEmpty (Path s)) ->
441+
B.GenericList Widgets Seq (NonEmpty Path) ->
442442
B.Widget Widgets
443443
renderWhyDependsModal l =
444444
B.renderList renderDepends True l
@@ -468,7 +468,7 @@ showWhyDepends env@AppEnv {aeActualStoreEnv} =
468468
(fromMaybe 0 $ ((==) `on` fmap spName) route `S.findIndexL` xs)
469469
}
470470

471-
renderSearchModal :: Text -> Text -> B.GenericList Widgets Seq (Path s) -> B.Widget Widgets
471+
renderSearchModal :: Text -> Text -> B.GenericList Widgets Seq Path -> B.Widget Widgets
472472
renderSearchModal left right l =
473473
renderModal "Search" window
474474
where
@@ -490,10 +490,10 @@ showAndUpdateSearch left right env@AppEnv {aeInvertedIndex} =
490490
& S.fromList
491491
in B.list WidgetSearch xs 1
492492

493-
move :: (List s -> List s) -> B.EventM n (AppEnv s) ()
493+
move :: (List -> List) -> B.EventM n (AppEnv s) ()
494494
move = moveF . modify
495495

496-
moveF :: B.EventM n (List s) () -> B.EventM n (AppEnv s) ()
496+
moveF :: B.EventM n List () -> B.EventM n (AppEnv s) ()
497497
moveF f = do
498498
B.zoom aeCurrPaneL f
499499
modify repopulateNextPane
@@ -534,7 +534,7 @@ repopulateNextPane env@AppEnv {aeActualStoreEnv, aeNextPane, aeSortOrder} =
534534
aeNextPane
535535
}
536536

537-
sortPane :: SortOrder -> List s -> List s
537+
sortPane :: SortOrder -> List -> List
538538
sortPane so l =
539539
let selected = B.listSelectedElement l
540540
elems =
@@ -552,10 +552,10 @@ sortPanes env@AppEnv {aeParents, aePrevPane, aeCurrPane, aeNextPane, aeSortOrder
552552
aePrevPane = sortPane aeSortOrder aePrevPane
553553
}
554554

555-
selectedPath :: AppEnv s -> Path s
555+
selectedPath :: AppEnv s -> Path
556556
selectedPath = NE.head . selectedPaths
557557

558-
selectedPaths :: AppEnv s -> NonEmpty (Path s)
558+
selectedPaths :: AppEnv s -> NonEmpty Path
559559
selectedPaths AppEnv {aePrevPane, aeCurrPane, aeParents} =
560560
let parents =
561561
mapMaybe
@@ -565,7 +565,7 @@ selectedPaths AppEnv {aePrevPane, aeCurrPane, aeParents} =
565565
Nothing -> error "invariant violation: no selected element"
566566
Just (_, p) -> p :| parents
567567

568-
selectPath :: NonEmpty (Path s) -> AppEnv s -> AppEnv s
568+
selectPath :: NonEmpty Path -> AppEnv s -> AppEnv s
569569
selectPath path env
570570
| (spName <$> path) == (spName <$> selectedPaths env) =
571571
env
@@ -602,9 +602,9 @@ selectPath path env@AppEnv {aeActualStoreEnv} =
602602
mkList ::
603603
SortOrder ->
604604
n ->
605-
Seq (Path s) ->
606-
Maybe (Path s) ->
607-
B.GenericList n Seq (Path s)
605+
Seq Path ->
606+
Maybe Path ->
607+
B.GenericList n Seq Path
608608
mkList sortOrder name possible selected =
609609
let contents = S.sortBy (compareBySortOrder sortOrder) possible
610610
in B.list name contents 1

‎src/NixTree/PathStats.hs

Lines changed: 67 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -13,21 +13,22 @@ import qualified Data.Map.Lazy as M
1313
import qualified Data.Set as S
1414
import NixTree.StorePath
1515

16-
data IntermediatePathStats s = IntermediatePathStats
17-
{ ipsAllRefs :: M.Map (StoreName s) (StorePath s (StoreName s) ())
16+
data IntermediatePathStats = IntermediatePathStats
17+
{ ipsAllRefs :: M.Map StoreName (StorePath StoreName ())
1818
}
1919

20-
data PathStats s = PathStats
20+
data PathStats = PathStats
2121
{ psTotalSize :: !Int,
2222
psAddedSize :: !Int,
23-
psImmediateParents :: [StoreName s]
23+
psImmediateParents :: [StoreName],
24+
psDisambiguationChars :: !Int
2425
}
2526
deriving (Show, Generic, NFData)
2627

2728
mkIntermediateEnv ::
28-
(StoreName s -> Bool) ->
29-
StoreEnv s () ->
30-
StoreEnv s (IntermediatePathStats s)
29+
(StoreName -> Bool) ->
30+
StoreEnv () ->
31+
StoreEnv IntermediatePathStats
3132
mkIntermediateEnv env =
3233
seBottomUp $ \curr ->
3334
IntermediatePathStats
@@ -42,10 +43,11 @@ mkIntermediateEnv env =
4243
)
4344
}
4445

45-
mkFinalEnv :: StoreEnv s (IntermediatePathStats s) -> StoreEnv s (PathStats s)
46+
mkFinalEnv :: StoreEnv IntermediatePathStats -> StoreEnv PathStats
4647
mkFinalEnv env =
4748
let totalSize = calculateEnvSize env
4849
immediateParents = calculateImmediateParents (sePaths env)
50+
disambiguationChars = seDisambiguationChars env
4951
in flip seBottomUp env $ \StorePath {spName, spSize, spPayload} ->
5052
let filteredSize =
5153
seFetchRefs env (/= spName) (seRoots env)
@@ -57,10 +59,13 @@ mkFinalEnv env =
5759
+ calculateRefsSize (ipsAllRefs spPayload),
5860
psAddedSize = addedSize,
5961
psImmediateParents =
60-
maybe [] S.toList $ M.lookup spName immediateParents
62+
maybe [] S.toList $ M.lookup spName immediateParents,
63+
psDisambiguationChars =
64+
M.lookup spName disambiguationChars
65+
& maybe 0 id
6166
}
6267
where
63-
calculateEnvSize :: StoreEnv s (IntermediatePathStats s) -> Int
68+
calculateEnvSize :: StoreEnv IntermediatePathStats -> Int
6469
calculateEnvSize e =
6570
seGetRoots e
6671
& toList
@@ -73,12 +78,12 @@ mkFinalEnv env =
7378
)
7479
& M.unions
7580
& calculateRefsSize
76-
calculateRefsSize :: (Functor f, Foldable f) => f (StorePath s a b) -> Int
81+
calculateRefsSize :: (Functor f, Foldable f) => f (StorePath a b) -> Int
7782
calculateRefsSize = sum . fmap spSize
7883
calculateImmediateParents ::
7984
(Foldable f) =>
80-
f (StorePath s (StoreName s) b) ->
81-
M.Map (StoreName s) (S.Set (StoreName s))
85+
f (StorePath StoreName b) ->
86+
M.Map StoreName (S.Set StoreName)
8287
calculateImmediateParents =
8388
foldl'
8489
( \m StorePath {spName, spRefs} ->
@@ -89,11 +94,56 @@ mkFinalEnv env =
8994
)
9095
M.empty
9196

92-
calculatePathStats :: StoreEnv s () -> StoreEnv s (PathStats s)
97+
seShortNames :: StoreEnv a -> M.Map Text [StoreName]
98+
seShortNames env =
99+
let paths = seAll env & toList
100+
in foldl'
101+
( \m StorePath {spName} ->
102+
let (_, shortName) = storeNameToSplitShortText spName
103+
in M.alter
104+
( \case
105+
Nothing -> Just [spName]
106+
Just xs -> Just (spName : xs)
107+
)
108+
shortName
109+
m
110+
)
111+
M.empty
112+
paths
113+
114+
seDisambiguationChars :: StoreEnv a -> M.Map StoreName Int
115+
seDisambiguationChars env =
116+
M.toList (seShortNames env)
117+
& map snd
118+
& concatMap
119+
( \xs ->
120+
let chrs = disambiguate xs
121+
in map (\x -> (x, chrs)) xs
122+
)
123+
& M.fromList
124+
125+
disambiguate :: [StoreName] -> Int
126+
disambiguate xs = go 0
127+
where
128+
go n =
129+
if isGood n
130+
then n
131+
else go (n + 2)
132+
133+
isGood n =
134+
xs
135+
& map (storeNameToShortTextWithDisambiguation n)
136+
& allUnique
137+
138+
allUnique xx =
139+
let unique = S.fromList xx
140+
in length unique == length xx
141+
142+
calculatePathStats :: StoreEnv () -> StoreEnv PathStats
93143
calculatePathStats = mkFinalEnv . mkIntermediateEnv (const True)
94144

95145
-- TODO: This can be precomputed.
96-
shortestPathTo :: StoreEnv s a -> StoreName s -> NonEmpty (StorePath s (StoreName s) a)
146+
shortestPathTo :: StoreEnv a -> StoreName -> NonEmpty (StorePath StoreName a)
97147
shortestPathTo env name =
98148
seBottomUp
99149
( \curr ->
@@ -121,9 +171,9 @@ shortestPathTo env name =
121171
-- We iterate the dependency graph bottom up. Every node contains a set of paths which represent
122172
-- the why-depends output from that node down. The set of paths is represented as a "Treeish" object,
123173
-- which is a trie-like structure.
124-
whyDepends :: forall s a. StoreEnv s a -> StoreName s -> [NonEmpty (StorePath s (StoreName s) a)]
174+
whyDepends :: forall a. StoreEnv a -> StoreName -> [NonEmpty (StorePath StoreName a)]
125175
whyDepends env name =
126-
seBottomUp @_ @_ @(Maybe (Treeish (StorePath s (StoreName s) a)))
176+
seBottomUp @_ @(Maybe (Treeish (StorePath StoreName a)))
127177
( \curr ->
128178
if spName curr == name
129179
then Just $ mkTreeish (curr {spRefs = map spName (spRefs curr)}) []

0 commit comments

Comments
 (0)