diff options
| -rw-r--r-- | utils/notes-util/Main.hs | 7 | ||||
| -rw-r--r-- | utils/notes-util/Notes.hs | 27 | ||||
| -rw-r--r-- | utils/notes-util/notes-util.cabal | 3 |
3 files changed, 33 insertions, 4 deletions
diff --git a/utils/notes-util/Main.hs b/utils/notes-util/Main.hs index ceaf4f9b04..aa9386bc01 100644 --- a/utils/notes-util/Main.hs +++ b/utils/notes-util/Main.hs @@ -27,13 +27,18 @@ main = do let printNoteDefs = putStrLn . unlines . map showNoteDef printNoteRefs = putStrLn . unlines . map showNoteRef + printNoteRefsSugg (bad, sugg) = do + putStrLn . showNoteRef $ bad + putStrLn $ " >" ++ showNoteDef sugg + parseMode :: String -> Maybe (NoteDb -> IO ()) parseMode "dump" = Just $ putStrLn . showNoteDb parseMode "unreferenced" = Just $ printNoteDefs . S.toList . unreferencedNotes parseMode "defs" = Just $ printNoteDefs . allNoteDefs parseMode "refs" = Just $ printNoteRefs . allNoteRefs - parseMode "broken-refs" = Just $ printNoteRefs . brokenNoteRefs + parseMode "broken-refs" = Just $ printNoteRefs . map fst . brokenNoteRefs + parseMode "broken-refs-suggest" = Just $ mapM_ printNoteRefsSugg . brokenNoteRefs parseMode _ = Nothing (mode, files) <- case args of diff --git a/utils/notes-util/Notes.hs b/utils/notes-util/Notes.hs index f27b483536..cf267d8d67 100644 --- a/utils/notes-util/Notes.hs +++ b/utils/notes-util/Notes.hs @@ -11,6 +11,9 @@ import qualified Data.Text.Encoding as T import qualified Data.Map.Strict as M import qualified Data.Set as S import System.Directory (doesFileExist) +import Data.Array +import Data.List (sortBy) +import Data.Ord data SrcLoc = SrcLoc { fileName :: FilePath , row :: !Int @@ -148,14 +151,34 @@ fileNotes fname = do } else return mempty -brokenNoteRefs :: NoteDb -> [NoteRef] +brokenNoteRefs :: NoteDb -> [(NoteRef, NoteDef)] brokenNoteRefs db = - [ ref + [ (ref, best_match) | (_fname, refs) <- M.toList (noteRefs db) , ref <- S.toList refs , Nothing <- pure $ M.lookup (noteRefName ref) (noteDefs db) + , let best_match = bestLev (show (noteRefName ref)) (concatMap S.toList (M.elems (noteDefs db))) ] +bestLev :: String -> [NoteDef] -> NoteDef +bestLev x ds = head $ sortBy (comparing (\d -> lev x (show (noteDefName d)))) ds + + +lev:: (Eq a) => [a] -> [a] -> Int +lev xs ys = levMemo ! (n, m) + where levMemo = array ((0,0),(n,m)) [((i,j),lev' i j) | i <- [0..n], j <- [0..m]] + n = length xs + m = length ys + xa = listArray (1, n) xs + ya = listArray (1, m) ys + lev' 0 v = v + lev' u 0 = u + lev' u v + | xa ! u == ya ! v = levMemo ! (u-1, v-1) + | otherwise = 1 + minimum [levMemo ! (u, v-1), + levMemo ! (u-1, v), + levMemo ! (u-1, v-1)] + unreferencedNotes :: NoteDb -> S.Set NoteDef unreferencedNotes db = fold $ noteDefs db `M.withoutKeys` referencedNotes diff --git a/utils/notes-util/notes-util.cabal b/utils/notes-util/notes-util.cabal index bba734e03b..41b1a5afdd 100644 --- a/utils/notes-util/notes-util.cabal +++ b/utils/notes-util/notes-util.cabal @@ -16,5 +16,6 @@ executable notes-util containers, directory, text, - process + process, + array default-language: Haskell2010 |