cabal-install-solver/src/Distribution/Solver/Modular/MessageUtils.hs

   1 -- | Utility functions providing extra context to cabal error messages
   2
   3 module Distribution.Solver.Modular.MessageUtils (
   4   allKnownExtensions,
   5   cutoffRange,
   6   mostSimilarElement,
   7   showUnsupportedExtension,
   8   showUnsupportedLanguage,
   9   withinRange
  10 ) where
  11
  12 import Data.Foldable (minimumBy)
  13 import Data.Ord (comparing)
  14 import Distribution.Pretty (prettyShow) -- from Cabal
  15 import Language.Haskell.Extension
  16          ( Extension(..), Language(..), knownLanguages, knownExtensions )
  17 import Text.EditDistance ( defaultEditCosts, levenshteinDistance )
  18
  19 showUnsupportedExtension :: Extension -> String
  20 showUnsupportedExtension (UnknownExtension extStr) = formatMessage cutoffRange "extension" extStr (mostSimilarElement extStr allKnownExtensions)
  21 showUnsupportedExtension extension = unwords [prettyShow extension, "which is not supported"]
  22
  23 showUnsupportedLanguage :: Language -> String
  24 showUnsupportedLanguage (UnknownLanguage langStr) = formatMessage cutoffRange "language" langStr (mostSimilarElement langStr (show <$> knownLanguages))
  25 showUnsupportedLanguage knownLanguage = unwords [prettyShow knownLanguage, "which is not supported"]
  26
  27 allKnownExtensions :: [String]
  28 allKnownExtensions = enabledExtensions ++ disabledExtensions
  29   where
  30     enabledExtensions = map (prettyShow . EnableExtension) knownExtensions
  31     disabledExtensions =  map (prettyShow . DisableExtension) knownExtensions
  32
  33 -- Measure the Levenshtein distance between two strings
  34 distance :: String -> String -> Int
  35 distance = levenshteinDistance defaultEditCosts
  36
  37 -- Given an `unknownElement` and a list of `elements` return the element
  38 -- from the list with the closest Levenshtein distance to the `unknownElement`
  39 mostSimilarElement :: String -> [String] -> String
  40 mostSimilarElement unknownElement elements = fst . minimumBy (comparing snd) . map mapDist $ elements
  41   where
  42     mapDist element = (element, distance unknownElement element)
  43
  44 -- Cutoff range for giving a suggested spelling
  45 cutoffRange :: Int
  46 cutoffRange = 10
  47
  48 formatMessage :: Int -> String -> String -> String -> String
  49 formatMessage range elementType element suggestion
  50   | withinRange range element suggestion =
  51     unwords ["unknown", elementType, element ++ ";", "did you mean", suggestion ++ "?"]
  52   | otherwise = unwords ["unknown", elementType, element]
  53
  54 -- Check whether the strings are within cutoff range
  55 withinRange :: Int -> String -> String -> Bool
  56 withinRange range element suggestion = distance element suggestion <= range