-- | Utility functions used for various searching purposes.
module SearchUtils
	( similarity
	, getDependency
	, getNameAndVersion
	, getVersion
	) where

import Control.Monad (liftM)
import Data.Char (toLower, isSpace)
import Data.Maybe (listToMaybe)
import Distribution.Version (Version)
import Distribution.Package (PackageName, Dependency(..))
import Distribution.Version (VersionRange(..))
import Distribution.Text (parse)
import Distribution.Compat.ReadP as ReadP (ReadP, char, (<++), readP_to_S)

-- | Compares two strings and returns the similarity of them.
similarity :: String -> String -> Double
similarity s1 s2
  | null ds = 0
  | otherwise = maximum ds
  where s  = map toLower s1
	ts = split $ map toLower s2
	split cs = case break (\c -> c == ',' || isSpace c) cs of
		(fs, _:bs) -> fs : split (dropWhile isSpace bs)
		(fs, [])   -> [fs]
	ds = [distance s t | t <- ts]

-- | A distance function for strings using the Levenshtein algorithm.
distance :: String -> String -> Double
distance [] [] = 1
distance s t = 1 - (fromIntegral (levenshtein s t)) / l
  where l = fromIntegral $ max (length s) (length t)
	-- "levenshtein s t" is at most the length of the longer string

-- | Levenshtein edit-distance algorithm.
--   Taken from the source code of lambdabot:
--   http://www.cse.unsw.edu.au/~dons/code/lambdabot/Lib/Util.hs
--   (Translated from an Erlang version by Fredrik Svensson and Adam Lindberg.)
levenshtein :: String -> String -> Int
levenshtein [] [] = 0
levenshtein s  [] = length s
levenshtein [] s  = length s
levenshtein s  t  = lvn s t [0..length t] 1

lvn :: String -> String -> [Int] -> Int -> Int
lvn [] _ dl _ = last dl
lvn (s:ss) t dl n = lvn ss t (lvn' t dl s [n] n) (n + 1)

lvn' :: String -> [Int] -> Char -> [Int] -> Int -> [Int]
lvn' [] _ _ ndl _ = ndl
lvn' (t:ts) (dlh:dlt) c ndl ld | length dlt > 0 = lvn' ts dlt c (ndl ++ [m]) m
  where m = foldl1 min [ld + 1, head dlt + 1, dlh + (dif t c)]
lvn' _ _ _ _  _  = error "levenshtein, ran out of numbers"

dif :: Char -> Char -> Int
dif = (fromEnum .) . (/=)

-- | Parses the argument to a dependency.
getDependency :: String -> Maybe Dependency
getDependency = wrapReadP $ do
	n <- parse
	v <- parse <++ return AnyVersion
	return (Dependency n v)

-- | Parses the argument to package name and an optional version.
--   Note: This functions is partly taken from Cabal (Distribution.Package).
getNameAndVersion :: String -> Maybe (PackageName, (Maybe Version))
getNameAndVersion = wrapReadP $ do
	n <- parse
	v <- (ReadP.char '-' >> liftM Just parse) <++ return Nothing
	return (n, v)

-- | Parses the argument to a version.
getVersion :: String -> Maybe Version
getVersion = wrapReadP parse

-- | A convience wrapper transforming "ReadP" into "Maybe".
wrapReadP :: ReadP a a -> String -> Maybe a
wrapReadP p string = listToMaybe [v |
	(v, rest) <- readP_to_S p string,
	null (dropWhile isSpace rest)]