{-
	Copyright (C) 2021 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* List-operations.

	* CAVEAT: import qualified to avoid clash with 'Data.List'.
-}

module BishBosh.Data.List(
-- * Functions
	findClosest,
	unabbreviate
) where

import			Control.Arrow((&&&))
import qualified	Data.List
import qualified	Data.List.Extra
import qualified	ToolShed.Data.List

{- |
	* Find the closest to the single item supplied, from the supplied choices.

	* All choices of equal proximity are returned.

	* CAVEAT: when applied to Strings, case-sensitivity should be considered by the caller.
-}
findClosest
	:: Eq a
	=> [a]		-- ^ Item.
	-> [[a]]	-- ^ Choices.
	-> [[a]]
findClosest :: [a] -> [[a]] -> [[a]]
findClosest [a]
_ []	= []
findClosest [a]
s [[a]]
choices	= case [(Rational, [a])] -> [(Rational, [[a]])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
Data.List.Extra.groupSort ([(Rational, [a])] -> [(Rational, [[a]])])
-> [(Rational, [a])] -> [(Rational, [[a]])]
forall a b. (a -> b) -> a -> b
$ ([a] -> (Rational, [a])) -> [[a]] -> [(Rational, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (
	(\Rational
d -> Rational
d :: Rational) (Rational -> Rational) -> ([a] -> Rational) -> [a] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
forall a. Num a => a -> a
negate {-largest Jaro-distance is the closest-} (Rational -> Rational) -> ([a] -> Rational) -> [a] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> Rational
forall a distance.
(Eq a, Fractional distance) =>
([a], [a]) -> distance
ToolShed.Data.List.measureJaroDistance (([a], [a]) -> Rational) -> ([a] -> ([a], [a])) -> [a] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) [a]
s ([a] -> Rational) -> ([a] -> [a]) -> [a] -> (Rational, [a])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [a] -> [a]
forall a. a -> a
id
 ) [[a]]
choices of
	(Rational
_, [[a]]
x) : [(Rational, [[a]])]
_	-> [[a]]
x
	[(Rational, [[a]])]
_		-> []

-- | Replace the abbreviated item with any item from the specified list, of which it's an unambiguously prefix.
unabbreviate
	:: Eq a
	=> ([a] -> [a])	-- ^ Translate.
	-> [[a]]	-- ^ Choices
	-> [a]		-- ^ Abbreviation.
	-> [a]
unabbreviate :: ([a] -> [a]) -> [[a]] -> [a] -> [a]
unabbreviate [a] -> [a]
f [[a]]
choices [a]
l	= case ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (
	[a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
Data.List.isPrefixOf ([a] -> [a]
f [a]
l) ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
f
 ) [[a]]
choices of
	[[a]
x]	-> [a]
x	-- Replace with unambiguous completion.
	[[a]]
_	-> [a]
l	-- Don't replace anything.