{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, ConstraintKinds #-}
{-# LANGUAGE Safe #-}

{- |
    Module      :  SDP.SortM
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)
    
    "SDP.SortM" provides 'SortM' - class of sortable mutable structures.
-}
module SDP.SortM
  (
    -- * SortM
    SortM (..), SortM1, sortM, sortMOn, sortedM, sortedMOn
  )
where

import Prelude ()
import SDP.SafePrelude

default ()

--------------------------------------------------------------------------------

-- | 'SortM' is class of sortable mutable structures.
class SortM m s e | s -> m, s -> e
  where
    {-# MINIMAL sortedMBy, sortMBy #-}
    
    {- |
      Checks if structure is already sorted. Should always return 'True' for
      structures with less than 2 elements.
    -}
    sortedMBy :: (e -> e -> Bool) -> s -> m Bool
    
    -- | 'sortMBy' is common sorting algorithm.
    sortMBy :: Compare e -> s -> m ()

--------------------------------------------------------------------------------

-- | Kind (* -> *) version of 'SortM'.
type SortM1 m s e = SortM m (s e) e

--------------------------------------------------------------------------------

-- | Checks if the structure is sorted.
sortedM :: (SortM m s e, Ord e) => s -> m Bool
sortedM :: s -> m Bool
sortedM =  (e -> e -> Bool) -> s -> m Bool
forall (m :: * -> *) s e.
SortM m s e =>
(e -> e -> Bool) -> s -> m Bool
sortedMBy e -> e -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

-- | Sort by comparing the results of a given function applied to each element.
sortedMOn :: (SortM m s e, Ord o) => (e -> o) -> s -> m Bool
sortedMOn :: (e -> o) -> s -> m Bool
sortedMOn =  (e -> e -> Bool) -> s -> m Bool
forall (m :: * -> *) s e.
SortM m s e =>
(e -> e -> Bool) -> s -> m Bool
sortedMBy ((e -> e -> Bool) -> s -> m Bool)
-> ((e -> o) -> e -> e -> Bool) -> (e -> o) -> s -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((o -> o -> Bool) -> (e -> o) -> e -> e -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on o -> o -> Bool
forall a. Ord a => a -> a -> Bool
(<=))

-- | 'sortM' is just @'sortMBy' 'compare'@
sortM :: (SortM m s e, Ord e) => s -> m ()
sortM :: s -> m ()
sortM =  Compare e -> s -> m ()
forall (m :: * -> *) s e. SortM m s e => Compare e -> s -> m ()
sortMBy Compare e
forall a. Ord a => a -> a -> Ordering
compare

-- | Sort by comparing the results of a key function applied to each element.
sortMOn :: (SortM m s e, Ord o) => (e -> o) -> s -> m ()
sortMOn :: (e -> o) -> s -> m ()
sortMOn =  Compare e -> s -> m ()
forall (m :: * -> *) s e. SortM m s e => Compare e -> s -> m ()
sortMBy (Compare e -> s -> m ())
-> ((e -> o) -> Compare e) -> (e -> o) -> s -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> o) -> Compare e
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing