module HGeometry.NonEmpty.Util
( extractMinimaBy
) where
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import HGeometry.Ext
extractMinimaBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a :+ [a]
a -> a -> Ordering
cmp (a
x:|[a]
xs) = (a -> (NonEmpty a :+ [a]) -> NonEmpty a :+ [a])
-> (NonEmpty a :+ [a]) -> [a] -> NonEmpty a :+ [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
y (mins :: NonEmpty a
mins@(a
m:|[a]
_) :+ [a]
rest) -> case a
m a -> a -> Ordering
`cmp` a
y of
Ordering
LT -> NonEmpty a
mins NonEmpty a -> [a] -> NonEmpty a :+ [a]
forall core extra. core -> extra -> core :+ extra
:+ a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest
Ordering
EQ -> (a
y a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.<| NonEmpty a
mins) NonEmpty a -> [a] -> NonEmpty a :+ [a]
forall core extra. core -> extra -> core :+ extra
:+ [a]
rest
Ordering
GT -> (a
ya -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[]) NonEmpty a -> [a] -> NonEmpty a :+ [a]
forall core extra. core -> extra -> core :+ extra
:+ NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty a
mins [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
rest
) ((a
xa -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[]) NonEmpty a -> [a] -> NonEmpty a :+ [a]
forall core extra. core -> extra -> core :+ extra
:+ []) [a]
xs