-- | 'Ordering' functions
module Music.Theory.Ord where

-- | Minimum by /f/.
min_by :: Ord a => (t -> a) -> t -> t -> t
min_by :: forall a t. Ord a => (t -> a) -> t -> t -> t
min_by t -> a
f t
p t
q = if t -> a
f t
p forall a. Ord a => a -> a -> Bool
<= t -> a
f t
q then t
p else t
q

-- | Specialised 'fromEnum'.
ord_to_int :: Ordering -> Int
ord_to_int :: Ordering -> Int
ord_to_int = forall a. Enum a => a -> Int
fromEnum

-- | Specialised 'toEnum'.
int_to_ord :: Int -> Ordering
int_to_ord :: Int -> Ordering
int_to_ord = forall a. Enum a => Int -> a
toEnum

-- | Invert 'Ordering'.
--
-- > map ord_invert [LT,EQ,GT] == [GT,EQ,LT]
ord_invert :: Ordering -> Ordering
ord_invert :: Ordering -> Ordering
ord_invert Ordering
x =
    case Ordering
x of
      Ordering
LT -> Ordering
GT
      Ordering
EQ -> Ordering
EQ
      Ordering
GT -> Ordering
LT

-- | Given 'Ordering', re-order pair,
order_pair :: Ordering -> (t,t) -> (t,t)
order_pair :: forall t. Ordering -> (t, t) -> (t, t)
order_pair Ordering
o (t
x,t
y) =
    case Ordering
o of
      Ordering
LT -> (t
x,t
y)
      Ordering
EQ -> (t
x,t
y)
      Ordering
GT -> (t
y,t
x)

-- | Sort a pair of equal type values using given comparison function.
--
-- > sort_pair compare ('b','a') == ('a','b')
sort_pair :: (t -> t -> Ordering) -> (t,t) -> (t,t)
sort_pair :: forall t. (t -> t -> Ordering) -> (t, t) -> (t, t)
sort_pair t -> t -> Ordering
fn (t
x,t
y) = forall t. Ordering -> (t, t) -> (t, t)
order_pair (t -> t -> Ordering
fn t
x t
y) (t
x,t
y)

-- | Variant where the comparison function may not compute a value.
sort_pair_m :: (t -> t -> Maybe Ordering) -> (t,t) -> Maybe (t,t)
sort_pair_m :: forall t. (t -> t -> Maybe Ordering) -> (t, t) -> Maybe (t, t)
sort_pair_m t -> t -> Maybe Ordering
fn (t
x,t
y) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall t. Ordering -> (t, t) -> (t, t)
`order_pair` (t
x,t
y)) (t -> t -> Maybe Ordering
fn t
x t
y)