-- | Utility functions providing extra context to cabal error messages

module Distribution.Solver.Modular.MessageUtils (
  allKnownExtensions,
  cutoffRange,
  mostSimilarElement,
  showUnsupportedExtension,
  showUnsupportedLanguage,
  withinRange
) where

import Data.Foldable (minimumBy)
import Data.Ord (comparing)
import Distribution.Pretty (prettyShow) -- from Cabal
import Language.Haskell.Extension
         ( Extension(..), Language(..), knownLanguages, knownExtensions )
import Text.EditDistance ( defaultEditCosts, levenshteinDistance )

showUnsupportedExtension :: Extension -> String
showUnsupportedExtension :: Extension -> String
showUnsupportedExtension (UnknownExtension String
extStr) = Int -> String -> String -> String -> String
formatMessage Int
cutoffRange String
"extension" String
extStr (String -> [String] -> String
mostSimilarElement String
extStr [String]
allKnownExtensions)
showUnsupportedExtension Extension
extension = [String] -> String
unwords [forall a. Pretty a => a -> String
prettyShow Extension
extension, String
"which is not supported"]

showUnsupportedLanguage :: Language -> String
showUnsupportedLanguage :: Language -> String
showUnsupportedLanguage (UnknownLanguage String
langStr) = Int -> String -> String -> String -> String
formatMessage Int
cutoffRange String
"language" String
langStr (String -> [String] -> String
mostSimilarElement String
langStr (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Language]
knownLanguages))
showUnsupportedLanguage Language
knownLanguage = [String] -> String
unwords [forall a. Pretty a => a -> String
prettyShow Language
knownLanguage, String
"which is not supported"]

allKnownExtensions :: [String]
allKnownExtensions :: [String]
allKnownExtensions = [String]
enabledExtensions forall a. [a] -> [a] -> [a]
++ [String]
disabledExtensions
  where
    enabledExtensions :: [String]
enabledExtensions = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownExtension -> Extension
EnableExtension) [KnownExtension]
knownExtensions
    disabledExtensions :: [String]
disabledExtensions =  forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownExtension -> Extension
DisableExtension) [KnownExtension]
knownExtensions

-- Measure the Levenshtein distance between two strings
distance :: String -> String -> Int
distance :: String -> String -> Int
distance = EditCosts -> String -> String -> Int
levenshteinDistance EditCosts
defaultEditCosts

-- Given an `unknownElement` and a list of `elements` return the element
-- from the list with the closest Levenshtein distance to the `unknownElement`
mostSimilarElement :: String -> [String] -> String
mostSimilarElement :: String -> [String] -> String
mostSimilarElement String
unknownElement [String]
elements = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> (String, Int)
mapDist forall a b. (a -> b) -> a -> b
$ [String]
elements
  where
    mapDist :: String -> (String, Int)
mapDist String
element = (String
element, String -> String -> Int
distance String
unknownElement String
element)

-- Cutoff range for giving a suggested spelling
cutoffRange :: Int
cutoffRange :: Int
cutoffRange = Int
10

formatMessage :: Int -> String -> String -> String -> String
formatMessage :: Int -> String -> String -> String -> String
formatMessage Int
range String
elementType String
element String
suggestion
  | Int -> String -> String -> Bool
withinRange Int
range String
element String
suggestion =
    [String] -> String
unwords [String
"unknown", String
elementType, String
element forall a. [a] -> [a] -> [a]
++ String
";", String
"did you mean", String
suggestion forall a. [a] -> [a] -> [a]
++ String
"?"]
  | Bool
otherwise = [String] -> String
unwords [String
"unknown", String
elementType, String
element]

-- Check whether the strings are within cutoff range
withinRange :: Int -> String -> String -> Bool
withinRange :: Int -> String -> String -> Bool
withinRange Int
range String
element String
suggestion = String -> String -> Int
distance String
element String
suggestion forall a. Ord a => a -> a -> Bool
<= Int
range