{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}

module Unison.Util.Alphabetical where

import Data.List qualified as List
import Data.List.NonEmpty qualified as List (NonEmpty)
import Data.RFC5051 qualified as RFC5051
import Data.Text (Text)

-- Alphabetical ordering used for sorting things to display to humans.
-- Should have 'A' and 'a' both come before 'B' and 'b', etc.
--
-- This need not coincide with the `Ord` instance for a type, which
-- is often an efficient yet arbitrary ordering that's used for
-- stashing the values in maps and sets.
class (Eq n) => Alphabetical n where
  compareAlphabetical :: n -> n -> Ordering

sortAlphabetically :: (Alphabetical a) => [a] -> [a]
sortAlphabetically :: forall a. Alphabetical a => [a] -> [a]
sortAlphabetically [a]
as = (\(OrderAlphabetically a
a) -> a
a) (OrderAlphabetically a -> a) -> [OrderAlphabetically a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OrderAlphabetically a] -> [OrderAlphabetically a]
forall a. Ord a => [a] -> [a]
List.sort ((a -> OrderAlphabetically a) -> [a] -> [OrderAlphabetically a]
forall a b. (a -> b) -> [a] -> [b]
map a -> OrderAlphabetically a
forall a. a -> OrderAlphabetically a
OrderAlphabetically [a]
as)

sortAlphabeticallyOn :: (Alphabetical a) => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn :: forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn b -> a
f = (b -> OrderAlphabetically a) -> [b] -> [b]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (a -> OrderAlphabetically a
forall a. a -> OrderAlphabetically a
OrderAlphabetically (a -> OrderAlphabetically a)
-> (b -> a) -> b -> OrderAlphabetically a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)

instance Alphabetical Text where
  compareAlphabetical :: Text -> Text -> Ordering
compareAlphabetical = Text -> Text -> Ordering
RFC5051.compareUnicode

-- newtype whose Ord instance uses alphabetical ordering
newtype OrderAlphabetically a = OrderAlphabetically a deriving ((forall a b.
 (a -> b) -> OrderAlphabetically a -> OrderAlphabetically b)
-> (forall a b.
    a -> OrderAlphabetically b -> OrderAlphabetically a)
-> Functor OrderAlphabetically
forall a b. a -> OrderAlphabetically b -> OrderAlphabetically a
forall a b.
(a -> b) -> OrderAlphabetically a -> OrderAlphabetically b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> OrderAlphabetically a -> OrderAlphabetically b
fmap :: forall a b.
(a -> b) -> OrderAlphabetically a -> OrderAlphabetically b
$c<$ :: forall a b. a -> OrderAlphabetically b -> OrderAlphabetically a
<$ :: forall a b. a -> OrderAlphabetically b -> OrderAlphabetically a
Functor, Functor OrderAlphabetically
Foldable OrderAlphabetically
(Functor OrderAlphabetically, Foldable OrderAlphabetically) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> OrderAlphabetically a -> f (OrderAlphabetically b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    OrderAlphabetically (f a) -> f (OrderAlphabetically a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> OrderAlphabetically a -> m (OrderAlphabetically b))
-> (forall (m :: * -> *) a.
    Monad m =>
    OrderAlphabetically (m a) -> m (OrderAlphabetically a))
-> Traversable OrderAlphabetically
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
OrderAlphabetically (m a) -> m (OrderAlphabetically a)
forall (f :: * -> *) a.
Applicative f =>
OrderAlphabetically (f a) -> f (OrderAlphabetically a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OrderAlphabetically a -> m (OrderAlphabetically b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrderAlphabetically a -> f (OrderAlphabetically b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrderAlphabetically a -> f (OrderAlphabetically b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrderAlphabetically a -> f (OrderAlphabetically b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
OrderAlphabetically (f a) -> f (OrderAlphabetically a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
OrderAlphabetically (f a) -> f (OrderAlphabetically a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OrderAlphabetically a -> m (OrderAlphabetically b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OrderAlphabetically a -> m (OrderAlphabetically b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
OrderAlphabetically (m a) -> m (OrderAlphabetically a)
sequence :: forall (m :: * -> *) a.
Monad m =>
OrderAlphabetically (m a) -> m (OrderAlphabetically a)
Traversable, (forall m. Monoid m => OrderAlphabetically m -> m)
-> (forall m a. Monoid m => (a -> m) -> OrderAlphabetically a -> m)
-> (forall m a. Monoid m => (a -> m) -> OrderAlphabetically a -> m)
-> (forall a b. (a -> b -> b) -> b -> OrderAlphabetically a -> b)
-> (forall a b. (a -> b -> b) -> b -> OrderAlphabetically a -> b)
-> (forall b a. (b -> a -> b) -> b -> OrderAlphabetically a -> b)
-> (forall b a. (b -> a -> b) -> b -> OrderAlphabetically a -> b)
-> (forall a. (a -> a -> a) -> OrderAlphabetically a -> a)
-> (forall a. (a -> a -> a) -> OrderAlphabetically a -> a)
-> (forall a. OrderAlphabetically a -> [a])
-> (forall a. OrderAlphabetically a -> Bool)
-> (forall a. OrderAlphabetically a -> Int)
-> (forall a. Eq a => a -> OrderAlphabetically a -> Bool)
-> (forall a. Ord a => OrderAlphabetically a -> a)
-> (forall a. Ord a => OrderAlphabetically a -> a)
-> (forall a. Num a => OrderAlphabetically a -> a)
-> (forall a. Num a => OrderAlphabetically a -> a)
-> Foldable OrderAlphabetically
forall a. Eq a => a -> OrderAlphabetically a -> Bool
forall a. Num a => OrderAlphabetically a -> a
forall a. Ord a => OrderAlphabetically a -> a
forall m. Monoid m => OrderAlphabetically m -> m
forall a. OrderAlphabetically a -> Bool
forall a. OrderAlphabetically a -> Int
forall a. OrderAlphabetically a -> [a]
forall a. (a -> a -> a) -> OrderAlphabetically a -> a
forall m a. Monoid m => (a -> m) -> OrderAlphabetically a -> m
forall b a. (b -> a -> b) -> b -> OrderAlphabetically a -> b
forall a b. (a -> b -> b) -> b -> OrderAlphabetically a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => OrderAlphabetically m -> m
fold :: forall m. Monoid m => OrderAlphabetically m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> OrderAlphabetically a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> OrderAlphabetically a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> OrderAlphabetically a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> OrderAlphabetically a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> OrderAlphabetically a -> b
foldr :: forall a b. (a -> b -> b) -> b -> OrderAlphabetically a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> OrderAlphabetically a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> OrderAlphabetically a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> OrderAlphabetically a -> b
foldl :: forall b a. (b -> a -> b) -> b -> OrderAlphabetically a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> OrderAlphabetically a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> OrderAlphabetically a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> OrderAlphabetically a -> a
foldr1 :: forall a. (a -> a -> a) -> OrderAlphabetically a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> OrderAlphabetically a -> a
foldl1 :: forall a. (a -> a -> a) -> OrderAlphabetically a -> a
$ctoList :: forall a. OrderAlphabetically a -> [a]
toList :: forall a. OrderAlphabetically a -> [a]
$cnull :: forall a. OrderAlphabetically a -> Bool
null :: forall a. OrderAlphabetically a -> Bool
$clength :: forall a. OrderAlphabetically a -> Int
length :: forall a. OrderAlphabetically a -> Int
$celem :: forall a. Eq a => a -> OrderAlphabetically a -> Bool
elem :: forall a. Eq a => a -> OrderAlphabetically a -> Bool
$cmaximum :: forall a. Ord a => OrderAlphabetically a -> a
maximum :: forall a. Ord a => OrderAlphabetically a -> a
$cminimum :: forall a. Ord a => OrderAlphabetically a -> a
minimum :: forall a. Ord a => OrderAlphabetically a -> a
$csum :: forall a. Num a => OrderAlphabetically a -> a
sum :: forall a. Num a => OrderAlphabetically a -> a
$cproduct :: forall a. Num a => OrderAlphabetically a -> a
product :: forall a. Num a => OrderAlphabetically a -> a
Foldable, OrderAlphabetically a -> OrderAlphabetically a -> Bool
(OrderAlphabetically a -> OrderAlphabetically a -> Bool)
-> (OrderAlphabetically a -> OrderAlphabetically a -> Bool)
-> Eq (OrderAlphabetically a)
forall a.
Eq a =>
OrderAlphabetically a -> OrderAlphabetically a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
OrderAlphabetically a -> OrderAlphabetically a -> Bool
== :: OrderAlphabetically a -> OrderAlphabetically a -> Bool
$c/= :: forall a.
Eq a =>
OrderAlphabetically a -> OrderAlphabetically a -> Bool
/= :: OrderAlphabetically a -> OrderAlphabetically a -> Bool
Eq)

instance (Eq a, Alphabetical a) => Ord (OrderAlphabetically a) where
  compare :: OrderAlphabetically a -> OrderAlphabetically a -> Ordering
compare (OrderAlphabetically a
a) (OrderAlphabetically a
b) = a -> a -> Ordering
forall n. Alphabetical n => n -> n -> Ordering
compareAlphabetical a
a a
b

instance (Alphabetical a) => Alphabetical [a] where
  compareAlphabetical :: [a] -> [a] -> Ordering
compareAlphabetical [a]
a1s [a]
a2s = [OrderAlphabetically a] -> [OrderAlphabetically a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> OrderAlphabetically a
forall a. a -> OrderAlphabetically a
OrderAlphabetically (a -> OrderAlphabetically a) -> [a] -> [OrderAlphabetically a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
a1s) (a -> OrderAlphabetically a
forall a. a -> OrderAlphabetically a
OrderAlphabetically (a -> OrderAlphabetically a) -> [a] -> [OrderAlphabetically a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
a2s)

instance (Alphabetical a) => Alphabetical (List.NonEmpty a) where
  compareAlphabetical :: NonEmpty a -> NonEmpty a -> Ordering
compareAlphabetical NonEmpty a
a1s NonEmpty a
a2s = NonEmpty (OrderAlphabetically a)
-> NonEmpty (OrderAlphabetically a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> OrderAlphabetically a
forall a. a -> OrderAlphabetically a
OrderAlphabetically (a -> OrderAlphabetically a)
-> NonEmpty a -> NonEmpty (OrderAlphabetically a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty a
a1s) (a -> OrderAlphabetically a
forall a. a -> OrderAlphabetically a
OrderAlphabetically (a -> OrderAlphabetically a)
-> NonEmpty a -> NonEmpty (OrderAlphabetically a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty a
a2s)

instance (Alphabetical a) => Alphabetical (Maybe a) where
  compareAlphabetical :: Maybe a -> Maybe a -> Ordering
compareAlphabetical Maybe a
a1s Maybe a
a2s = Maybe (OrderAlphabetically a)
-> Maybe (OrderAlphabetically a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> OrderAlphabetically a
forall a. a -> OrderAlphabetically a
OrderAlphabetically (a -> OrderAlphabetically a)
-> Maybe a -> Maybe (OrderAlphabetically a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
a1s) (a -> OrderAlphabetically a
forall a. a -> OrderAlphabetically a
OrderAlphabetically (a -> OrderAlphabetically a)
-> Maybe a -> Maybe (OrderAlphabetically a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
a2s)