{-# LANGUAGE OverloadedStrings #-}
module Swarm.TUI.Inventory.Sorting (
InventorySortOptions (..),
InventorySortDirection (..),
InventorySortOrder (..),
cycleSortOrder,
cycleSortDirection,
defaultSortOptions,
sortInventory,
renderSortMethod,
) where
import Algorithms.NaturalSort (sortKey)
import Control.Lens (view)
import Data.List (sortBy)
import Data.Ord (Down (Down), comparing)
import Data.Text qualified as T
import Swarm.Game.Entity as E
import Swarm.Util (cycleEnum)
data InventorySortDirection
= Ascending
| Descending
deriving (Int -> InventorySortDirection
InventorySortDirection -> Int
InventorySortDirection -> [InventorySortDirection]
InventorySortDirection -> InventorySortDirection
InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection]
InventorySortDirection
-> InventorySortDirection
-> InventorySortDirection
-> [InventorySortDirection]
(InventorySortDirection -> InventorySortDirection)
-> (InventorySortDirection -> InventorySortDirection)
-> (Int -> InventorySortDirection)
-> (InventorySortDirection -> Int)
-> (InventorySortDirection -> [InventorySortDirection])
-> (InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection])
-> (InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection])
-> (InventorySortDirection
-> InventorySortDirection
-> InventorySortDirection
-> [InventorySortDirection])
-> Enum InventorySortDirection
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: InventorySortDirection -> InventorySortDirection
succ :: InventorySortDirection -> InventorySortDirection
$cpred :: InventorySortDirection -> InventorySortDirection
pred :: InventorySortDirection -> InventorySortDirection
$ctoEnum :: Int -> InventorySortDirection
toEnum :: Int -> InventorySortDirection
$cfromEnum :: InventorySortDirection -> Int
fromEnum :: InventorySortDirection -> Int
$cenumFrom :: InventorySortDirection -> [InventorySortDirection]
enumFrom :: InventorySortDirection -> [InventorySortDirection]
$cenumFromThen :: InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection]
enumFromThen :: InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection]
$cenumFromTo :: InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection]
enumFromTo :: InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection]
$cenumFromThenTo :: InventorySortDirection
-> InventorySortDirection
-> InventorySortDirection
-> [InventorySortDirection]
enumFromThenTo :: InventorySortDirection
-> InventorySortDirection
-> InventorySortDirection
-> [InventorySortDirection]
Enum, InventorySortDirection
InventorySortDirection
-> InventorySortDirection -> Bounded InventorySortDirection
forall a. a -> a -> Bounded a
$cminBound :: InventorySortDirection
minBound :: InventorySortDirection
$cmaxBound :: InventorySortDirection
maxBound :: InventorySortDirection
Bounded, InventorySortDirection -> InventorySortDirection -> Bool
(InventorySortDirection -> InventorySortDirection -> Bool)
-> (InventorySortDirection -> InventorySortDirection -> Bool)
-> Eq InventorySortDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InventorySortDirection -> InventorySortDirection -> Bool
== :: InventorySortDirection -> InventorySortDirection -> Bool
$c/= :: InventorySortDirection -> InventorySortDirection -> Bool
/= :: InventorySortDirection -> InventorySortDirection -> Bool
Eq)
data InventorySortOrder
= ByNaturalAlphabetic
| ByQuantity
| ByType
deriving (Int -> InventorySortOrder
InventorySortOrder -> Int
InventorySortOrder -> [InventorySortOrder]
InventorySortOrder -> InventorySortOrder
InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
InventorySortOrder
-> InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
(InventorySortOrder -> InventorySortOrder)
-> (InventorySortOrder -> InventorySortOrder)
-> (Int -> InventorySortOrder)
-> (InventorySortOrder -> Int)
-> (InventorySortOrder -> [InventorySortOrder])
-> (InventorySortOrder
-> InventorySortOrder -> [InventorySortOrder])
-> (InventorySortOrder
-> InventorySortOrder -> [InventorySortOrder])
-> (InventorySortOrder
-> InventorySortOrder
-> InventorySortOrder
-> [InventorySortOrder])
-> Enum InventorySortOrder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: InventorySortOrder -> InventorySortOrder
succ :: InventorySortOrder -> InventorySortOrder
$cpred :: InventorySortOrder -> InventorySortOrder
pred :: InventorySortOrder -> InventorySortOrder
$ctoEnum :: Int -> InventorySortOrder
toEnum :: Int -> InventorySortOrder
$cfromEnum :: InventorySortOrder -> Int
fromEnum :: InventorySortOrder -> Int
$cenumFrom :: InventorySortOrder -> [InventorySortOrder]
enumFrom :: InventorySortOrder -> [InventorySortOrder]
$cenumFromThen :: InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
enumFromThen :: InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
$cenumFromTo :: InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
enumFromTo :: InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
$cenumFromThenTo :: InventorySortOrder
-> InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
enumFromThenTo :: InventorySortOrder
-> InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
Enum, InventorySortOrder
InventorySortOrder
-> InventorySortOrder -> Bounded InventorySortOrder
forall a. a -> a -> Bounded a
$cminBound :: InventorySortOrder
minBound :: InventorySortOrder
$cmaxBound :: InventorySortOrder
maxBound :: InventorySortOrder
Bounded, InventorySortOrder -> InventorySortOrder -> Bool
(InventorySortOrder -> InventorySortOrder -> Bool)
-> (InventorySortOrder -> InventorySortOrder -> Bool)
-> Eq InventorySortOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InventorySortOrder -> InventorySortOrder -> Bool
== :: InventorySortOrder -> InventorySortOrder -> Bool
$c/= :: InventorySortOrder -> InventorySortOrder -> Bool
/= :: InventorySortOrder -> InventorySortOrder -> Bool
Eq)
data InventorySortOptions = InventorySortOptions InventorySortDirection InventorySortOrder
defaultSortOptions :: InventorySortOptions
defaultSortOptions :: InventorySortOptions
defaultSortOptions = InventorySortDirection
-> InventorySortOrder -> InventorySortOptions
InventorySortOptions InventorySortDirection
Ascending InventorySortOrder
ByNaturalAlphabetic
renderSortMethod :: InventorySortOptions -> T.Text
renderSortMethod :: InventorySortOptions -> Text
renderSortMethod (InventorySortOptions InventorySortDirection
direction InventorySortOrder
order) =
[Text] -> Text
T.unwords [Text
prefix, Text
label]
where
prefix :: Text
prefix = case InventorySortDirection
direction of
InventorySortDirection
Ascending -> Text
"↑"
InventorySortDirection
Descending -> Text
"↓"
label :: Text
label = case InventorySortOrder
order of
InventorySortOrder
ByNaturalAlphabetic -> Text
"name"
InventorySortOrder
ByQuantity -> Text
"count"
InventorySortOrder
ByType -> Text
"type"
cycleSortOrder :: InventorySortOptions -> InventorySortOptions
cycleSortOrder :: InventorySortOptions -> InventorySortOptions
cycleSortOrder (InventorySortOptions InventorySortDirection
direction InventorySortOrder
order) =
InventorySortDirection
-> InventorySortOrder -> InventorySortOptions
InventorySortOptions InventorySortDirection
direction (InventorySortOrder -> InventorySortOrder
forall e. (Eq e, Enum e, Bounded e) => e -> e
cycleEnum InventorySortOrder
order)
cycleSortDirection :: InventorySortOptions -> InventorySortOptions
cycleSortDirection :: InventorySortOptions -> InventorySortOptions
cycleSortDirection (InventorySortOptions InventorySortDirection
direction InventorySortOrder
order) =
InventorySortDirection
-> InventorySortOrder -> InventorySortOptions
InventorySortOptions (InventorySortDirection -> InventorySortDirection
forall e. (Eq e, Enum e, Bounded e) => e -> e
cycleEnum InventorySortDirection
direction) InventorySortOrder
order
getSortComparator :: Ord a => InventorySortOptions -> (a, Entity) -> (a, Entity) -> Ordering
getSortComparator :: forall a.
Ord a =>
InventorySortOptions -> (a, Entity) -> (a, Entity) -> Ordering
getSortComparator (InventorySortOptions InventorySortDirection
direction InventorySortOrder
order) = case InventorySortOrder
order of
InventorySortOrder
ByNaturalAlphabetic -> ((a, Entity) -> SortKey) -> (a, Entity) -> (a, Entity) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
compReversible (Entity -> SortKey
alphabetic (Entity -> SortKey)
-> ((a, Entity) -> Entity) -> (a, Entity) -> SortKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Entity) -> Entity
forall a b. (a, b) -> b
snd)
InventorySortOrder
ByQuantity -> ((a, Entity) -> a) -> (a, Entity) -> (a, Entity) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
compReversible (a, Entity) -> a
forall a b. (a, b) -> a
fst ((a, Entity) -> (a, Entity) -> Ordering)
-> ((a, Entity) -> (a, Entity) -> Ordering)
-> (a, Entity)
-> (a, Entity)
-> Ordering
forall a. Semigroup a => a -> a -> a
<> (a, Entity) -> (a, Entity) -> Ordering
forall {a}. (a, Entity) -> (a, Entity) -> Ordering
secondary
InventorySortOrder
ByType -> ((a, Entity) -> Set EntityProperty)
-> (a, Entity) -> (a, Entity) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
compReversible (Getting (Set EntityProperty) Entity (Set EntityProperty)
-> Entity -> Set EntityProperty
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set EntityProperty) Entity (Set EntityProperty)
Lens' Entity (Set EntityProperty)
entityProperties (Entity -> Set EntityProperty)
-> ((a, Entity) -> Entity) -> (a, Entity) -> Set EntityProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Entity) -> Entity
forall a b. (a, b) -> b
snd) ((a, Entity) -> (a, Entity) -> Ordering)
-> ((a, Entity) -> (a, Entity) -> Ordering)
-> (a, Entity)
-> (a, Entity)
-> Ordering
forall a. Semigroup a => a -> a -> a
<> (a, Entity) -> (a, Entity) -> Ordering
forall {a}. (a, Entity) -> (a, Entity) -> Ordering
secondary
where
alphabetic :: Entity -> SortKey
alphabetic = Text -> SortKey
forall a. NaturalSort a => a -> SortKey
sortKey (Text -> SortKey) -> (Entity -> Text) -> Entity -> SortKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Entity -> Text) -> Entity -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text Entity Text -> Entity -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName
secondary :: (a, Entity) -> (a, Entity) -> Ordering
secondary = ((a, Entity) -> SortKey) -> (a, Entity) -> (a, Entity) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Entity -> SortKey
alphabetic (Entity -> SortKey)
-> ((a, Entity) -> Entity) -> (a, Entity) -> SortKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Entity) -> Entity
forall a b. (a, b) -> b
snd)
compReversible :: Ord a => (b -> a) -> b -> b -> Ordering
compReversible :: forall a b. Ord a => (b -> a) -> b -> b -> Ordering
compReversible = case InventorySortDirection
direction of
InventorySortDirection
Ascending -> (b -> a) -> b -> b -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing
InventorySortDirection
Descending -> \b -> a
f -> (b -> Down a) -> b -> b -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a -> Down a
forall a. a -> Down a
Down (a -> Down a) -> (b -> a) -> b -> Down a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
sortInventory :: Ord a => InventorySortOptions -> [(a, Entity)] -> [(a, Entity)]
sortInventory :: forall a.
Ord a =>
InventorySortOptions -> [(a, Entity)] -> [(a, Entity)]
sortInventory InventorySortOptions
opts =
((a, Entity) -> (a, Entity) -> Ordering)
-> [(a, Entity)] -> [(a, Entity)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((a, Entity) -> (a, Entity) -> Ordering)
-> [(a, Entity)] -> [(a, Entity)])
-> ((a, Entity) -> (a, Entity) -> Ordering)
-> [(a, Entity)]
-> [(a, Entity)]
forall a b. (a -> b) -> a -> b
$ InventorySortOptions -> (a, Entity) -> (a, Entity) -> Ordering
forall a.
Ord a =>
InventorySortOptions -> (a, Entity) -> (a, Entity) -> Ordering
getSortComparator InventorySortOptions
opts