@@ -4,6 +4,7 @@
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,6 +32,7 @@
#:use-module ((guix profiles) #:select (%profile-directory))
#:autoload (guix describe) (current-profile-date)
#:use-module (guix build syscalls)
+ #:use-module (guix memoization)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-37)
@@ -112,6 +114,61 @@ procedure, but both the category and synopsis are meant to be read (parsed) by
doc
body ...)))))
+(define (levenshtein-distance s1 s2)
+ "Compute the Levenshtein distance between two strings."
+ ;; Naive implemenation
+ (define loop
+ (memoize
+ (lambda (as bt)
+ (match as
+ ('() (length bt))
+ (_ (match bt
+ ('() (length as))
+ (_
+ (let ((a (car as))
+ (s (cdr as))
+ (b (car bt))
+ (t (cdr bt)))
+ (if (char=? a b)
+ (loop s t)
+ (1+ (min
+ (loop as t)
+ (loop s bt)
+ (loop s t))))))))))))
+
+ (let ((c1 (string->list s1))
+ (c2 (string->list s2)))
+ (loop c1 c2)))
+
+(define (options->long-names options)
+ "Return long names from options."
+ (fold (lambda (name res)
+ (match name
+ ((? char?) res)
+ ((? string?) (cons name res))))
+ '()
+ (fold append '() (map option-names options))))
+
+(define (option-hint name options)
+ "Return the closest long-name from name based on Levenshtein distance."
+ (fold (lambda (name res)
+ (if (string-null? res)
+ name
+ (string-append name " or " res)))
+ ""
+ (cadr (fold (lambda (long-name res)
+ (let ((dist (levenshtein-distance name long-name)))
+ (match res
+ ((val lst)
+ (if (< dist val)
+ (list dist (list long-name))
+ (if (= dist val)
+ (list dist (cons long-name lst))
+ res)))
+ (_ (list dist (list long-name))))))
+ '()
+ (options->long-names options)))))
+
(define (args-fold* args options unrecognized-option-proc operand-proc . seeds)
"A wrapper on top of `args-fold' that does proper user-facing error
reporting."
@@ -149,6 +206,7 @@ parameter of 'args-fold'."
;; Actual parsing takes place here.
(apply args-fold* args options
(lambda (opt name arg . rest)
+ (display-hint (format #f (G_ "Do you mean @code{~a}?~%") (option-hint name options)))
(leave (G_ "~A: unrecognized option~%") name))
argument-handler
seeds))