{-# 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]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InventorySortDirection
-> InventorySortDirection
-> InventorySortDirection
-> [InventorySortDirection]
$cenumFromThenTo :: InventorySortDirection
-> InventorySortDirection
-> InventorySortDirection
-> [InventorySortDirection]
enumFromTo :: InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection]
$cenumFromTo :: InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection]
enumFromThen :: InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection]
$cenumFromThen :: InventorySortDirection
-> InventorySortDirection -> [InventorySortDirection]
enumFrom :: InventorySortDirection -> [InventorySortDirection]
$cenumFrom :: InventorySortDirection -> [InventorySortDirection]
fromEnum :: InventorySortDirection -> Int
$cfromEnum :: InventorySortDirection -> Int
toEnum :: Int -> InventorySortDirection
$ctoEnum :: Int -> InventorySortDirection
pred :: InventorySortDirection -> InventorySortDirection
$cpred :: InventorySortDirection -> InventorySortDirection
succ :: InventorySortDirection -> InventorySortDirection
$csucc :: InventorySortDirection -> InventorySortDirection
Enum, InventorySortDirection
forall a. a -> a -> Bounded a
maxBound :: InventorySortDirection
$cmaxBound :: InventorySortDirection
minBound :: InventorySortDirection
$cminBound :: InventorySortDirection
Bounded, InventorySortDirection -> InventorySortDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InventorySortDirection -> InventorySortDirection -> Bool
$c/= :: InventorySortDirection -> InventorySortDirection -> Bool
== :: InventorySortDirection -> InventorySortDirection -> Bool
$c== :: 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]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InventorySortOrder
-> InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
$cenumFromThenTo :: InventorySortOrder
-> InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
enumFromTo :: InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
$cenumFromTo :: InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
enumFromThen :: InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
$cenumFromThen :: InventorySortOrder -> InventorySortOrder -> [InventorySortOrder]
enumFrom :: InventorySortOrder -> [InventorySortOrder]
$cenumFrom :: InventorySortOrder -> [InventorySortOrder]
fromEnum :: InventorySortOrder -> Int
$cfromEnum :: InventorySortOrder -> Int
toEnum :: Int -> InventorySortOrder
$ctoEnum :: Int -> InventorySortOrder
pred :: InventorySortOrder -> InventorySortOrder
$cpred :: InventorySortOrder -> InventorySortOrder
succ :: InventorySortOrder -> InventorySortOrder
$csucc :: InventorySortOrder -> InventorySortOrder
Enum, InventorySortOrder
forall a. a -> a -> Bounded a
maxBound :: InventorySortOrder
$cmaxBound :: InventorySortOrder
minBound :: InventorySortOrder
$cminBound :: InventorySortOrder
Bounded, InventorySortOrder -> InventorySortOrder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InventorySortOrder -> InventorySortOrder -> Bool
$c/= :: InventorySortOrder -> InventorySortOrder -> Bool
== :: InventorySortOrder -> InventorySortOrder -> Bool
$c== :: 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 (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 (forall e. (Eq e, Enum e, Bounded e) => e -> e
cycleEnum InventorySortDirection
direction) InventorySortOrder
order

-- | All non-alphabetic sort criteria perform alphabetic tie-breaking.
-- "Reverse ordering" only applies to the *primary* sort criteria; the secondary
-- alphabetic sort is always in ascending order.
getSortCompartor :: Ord a => InventorySortOptions -> (a, Entity) -> (a, Entity) -> Ordering
getSortCompartor :: forall a.
Ord a =>
InventorySortOptions -> (a, Entity) -> (a, Entity) -> Ordering
getSortCompartor (InventorySortOptions InventorySortDirection
direction InventorySortOrder
order) = case InventorySortOrder
order of
  InventorySortOrder
ByNaturalAlphabetic -> forall a b. Ord a => (b -> a) -> b -> b -> Ordering
compReversible (Entity -> SortKey
alphabetic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
  InventorySortOrder
ByQuantity -> forall a b. Ord a => (b -> a) -> b -> b -> Ordering
compReversible forall a b. (a, b) -> a
fst forall a. Semigroup a => a -> a -> a
<> forall {a}. (a, Entity) -> (a, Entity) -> Ordering
secondary
  InventorySortOrder
ByType -> forall a b. Ord a => (b -> a) -> b -> b -> Ordering
compReversible (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Entity (Set EntityProperty)
entityProperties forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a. Semigroup a => a -> a -> a
<> forall {a}. (a, Entity) -> (a, Entity) -> Ordering
secondary
 where
  alphabetic :: Entity -> SortKey
alphabetic = forall a. NaturalSort a => a -> SortKey
sortKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Entity Text
entityName
  secondary :: (a, Entity) -> (a, Entity) -> Ordering
secondary = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Entity -> SortKey
alphabetic forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing
    InventorySortDirection
Descending -> \b -> a
f -> forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall a. a -> Down a
Down 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 =
  forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall a b. (a -> b) -> a -> b
$ forall a.
Ord a =>
InventorySortOptions -> (a, Entity) -> (a, Entity) -> Ordering
getSortCompartor InventorySortOptions
opts