Add suggestion mode to notes-util

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