-- | Provides functions to search through all packages available on HackageDB
--   and to match package descriptions against search strings.
module SearchAlgorithm
	( SearchResult(..)
	, search
	, searchKeys
	) where

import Data.Char (toLower)
import Data.List (nub, sortBy, partition)
import qualified Data.Map as Map (Map, map, fromList, toList, lookup,
				foldWithKey, empty, insert, filter)
import Data.Maybe (mapMaybe)
import Data.Ord (comparing)
import Data.Version (Version(..))
import Distribution.Package (PackageIdentifier(..), Dependency(..))
import Distribution.PackageDescription as Cabal (PackageDescription(..))
import Distribution.Text (display)
import Distribution.Version (withinRange)

import SearchHackage (withEveryPackage)
import SearchMatchingFunctions (searchKeys, searchMap, matchAnything)
import SearchTypes

-- | Computes the subset of all packages available at Hackage which match a
--   given search string.
--   The only purpose of the "IO" monad is to be able to access each package's
--   description.
search ::
	Double		-- ^ A threshold value. Search results with a ranking
			-- value less than this are ignored.
	-> String	-- ^ The search string. Each word may be tagged by a
			-- search key.
	-> IO [SearchResult]
			-- ^ The matching results.
search threshold searchString = do
	-- parse string into matching functions
	let queries = map parseQuery $ words searchString
	    locals  = mapMaybe (either Just (const Nothing)) queries
	    globals = mapMaybe (either (const Nothing) Just) queries

	-- combine the local matching functions
	let localMatchFunction pd mMap
	      -- make sure that all packages are in the map, even if no
	      -- query was given
	      | null locals = Map.insert (package pd) Map.empty mMap
	      | otherwise = foldr ($ pd) mMap locals

	-- collect global information and match the local matching functions
	(allPkgs, synopsisMap, buildDepMap, matchMap) <-
		withEveryPackage
			(\ (pkgs, synMap, depMap, mMap) pd ->
				let pkg = package pd
				in ( pkg : pkgs
				   , Map.insert pkg (synopsis pd) synMap
				   , Map.insert pkg (buildDepends pd) depMap
				   , localMatchFunction pd mMap
				   ))
			([], Map.empty, Map.empty, Map.empty)
	let globalData = makeGlobalData allPkgs buildDepMap

	-- apply the global matching functions
	let matchMap' = foldr ($ globalData) matchMap globals

	-- create a sorted list of search results
	let threshold' = threshold * (fromIntegral $ length queries)
	return (makeSearchResults threshold' synopsisMap matchMap')

-- | Determines the matching function for a word of the search string.
parseQuery :: String -> Either LocalMatchingFunction GlobalMatchingFunction
parseQuery string
  -- If "string" starts with a search key, then the corresponding matching
  -- function is chosen, otherwise a generic (local) matching function is taken.
  | null key || null value = Left $ matchAnything string
  | otherwise = case lookup key searchMap of
	Nothing -> Left $ matchAnything string
	Just mf -> either (\f -> Left $ f value) (\f -> Right $ f value) mf
  where (key,v) = break (== ':') string
	value = if null v then "" else tail v

-- | Constructs the dependency mapping and the requirements mapping.
makeGlobalData ::
	[PackageIdentifier]
		-- ^ A list of available packages.
	-> Map.Map PackageIdentifier [Dependency]
		-- ^ Maps package identifiers to their dependencies.
	-> GlobalData
makeGlobalData allPkgs buildDepMap = GlobalData
	{ allAvailablePackages = allPkgs
	, dependsOnMap = depMap
	, requiredByMap = reqMap
	}
  where	-- determines all packages satisfying a dependency,
	-- unresolved dependencies are treated as packages without version
	satisfy (Dependency name vrange) = case filter fitting allPkgs of
		[] -> [PackageIdentifier name (Version [] [])]
		ps -> ps
	  where fitting pkg = pkgName pkg == name &&
			(pkgVersion pkg `withinRange` vrange)

	-- maps each available package to the list of packages it requires
	reqMap = Map.map (nub . concatMap satisfy) buildDepMap

	-- the reversed version of the requiredByMap, i.e. a mapping of
	-- each package to all packages depending on that package
	depMap = Map.fromList $ map (\p -> (p, reqs p)) allPkgs
	  where reqs p = Map.foldWithKey
				(\k v -> if p `elem` v then (k :) else id)
				[]
				reqMap

-- | Based on matching values, all acceptable packages are extracted and sorted
--   to a list of search results.
makeSearchResults ::
	Double	-- ^ A threshold value used to select acceptable matching values.
		--   All packages having a matching less than this threshold are
		--   discarded.
	-> Map.Map PackageIdentifier String
		-- ^ Maps package identifiers to their synopsis.
	-> MatchingMap
		-- ^ Maps package identifiers to matching values.
	-> [SearchResult]
makeSearchResults threshold synopsisMap matchMap =
	map toSearchResult	-- create search result structures
	. groupResults		-- group packages of the same name
	. sortBy resultOrder
	. Map.toList
	. Map.filter (\ms -> sum (map snd ms) >= threshold)
				-- take only the good results
	$ Map.map Map.toList matchMap
  where resultOrder (p1,m1) (p2,m2) =
		-- compare first the matching value (best comes first)
		case compare (sum (map snd m2)) (sum (map snd m1)) of
		    EQ -> -- then compare the package name lexicographically
			case comparing (map toLower . display . pkgName) p1 p2 of
			    EQ -> -- finally compare the package version
				-- (latest comes first)
				comparing pkgVersion p2 p1
			    lg -> lg
		    lg -> lg

	toSearchResult (p,ps,m) = SearchResult p syn (map pkgVersion ps) m
	  where syn = maybe "" id $ Map.lookup p synopsisMap

-- | Groups packages with the same name. The package occurring first in
-- the list is returned as first component of a tuple, all other packages
-- with the same name are returned as the second component of that tuple.
groupResults ::
	[(PackageIdentifier, [(String, Double)])]
	-> [(PackageIdentifier, [PackageIdentifier], [(String, Double)])]
groupResults [] = []
groupResults ((pkg,m):pkgs) =
	(pkg, map fst samePkgs, m) : groupResults otherPkgs
  where (samePkgs, otherPkgs) =
		partition (\(p, _) -> pkgName p == pkgName pkg) pkgs