packages feed

swarm-0.4: src/Swarm/TUI/Inventory/Sorting.hs

{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
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 (Enum, Bounded, Eq)

data InventorySortOrder
  = ByNaturalAlphabetic
  | ByQuantity
  | ByType
  deriving (Enum, Bounded, Eq)

data InventorySortOptions = InventorySortOptions InventorySortDirection InventorySortOrder

defaultSortOptions :: InventorySortOptions
defaultSortOptions = InventorySortOptions Ascending ByNaturalAlphabetic

renderSortMethod :: InventorySortOptions -> T.Text
renderSortMethod (InventorySortOptions direction order) =
  T.unwords [prefix, label]
 where
  prefix = case direction of
    Ascending -> "↑"
    Descending -> "↓"
  label = case order of
    ByNaturalAlphabetic -> "name"
    ByQuantity -> "count"
    ByType -> "type"

cycleSortOrder :: InventorySortOptions -> InventorySortOptions
cycleSortOrder (InventorySortOptions direction order) =
  InventorySortOptions direction (cycleEnum order)

cycleSortDirection :: InventorySortOptions -> InventorySortOptions
cycleSortDirection (InventorySortOptions direction order) =
  InventorySortOptions (cycleEnum direction) 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 (InventorySortOptions direction order) = case order of
  ByNaturalAlphabetic -> compReversible (alphabetic . snd)
  ByQuantity -> compReversible fst <> secondary
  ByType -> compReversible (view entityProperties . snd) <> secondary
 where
  alphabetic = sortKey . T.toLower . view entityName
  secondary = comparing (alphabetic . snd)

  compReversible :: Ord a => (b -> a) -> b -> b -> Ordering
  compReversible = case direction of
    Ascending -> comparing
    Descending -> \f -> comparing (Down . f)

sortInventory :: Ord a => InventorySortOptions -> [(a, Entity)] -> [(a, Entity)]
sortInventory opts =
  sortBy $ getSortCompartor opts