{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK hide #-}

module Data.Ord.Linear.Internal.Ord
  ( Ord (..),
    Ordering (..),
    min,
    max,
  )
where

import Data.Bool.Linear (Bool (..), not)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Monoid.Linear
import Data.Ord (Ordering (..))
import Data.Ord.Linear.Internal.Eq
import Data.Unrestricted.Linear
import Data.Word (Word16, Word32, Word64, Word8)
import Prelude.Linear.Internal
import qualified Prelude

-- | Linear Orderings
--
-- Linear orderings provide a strict order. The laws for @(<=)@ for
-- all \(a,b,c\):
--
-- * reflexivity: \(a \leq a \)
-- * antisymmetry: \((a \leq b) \land (b \leq a) \rightarrow (a = b) \)
-- * transitivity: \((a \leq b) \land (b \leq c) \rightarrow (a \leq c) \)
--
-- and these \"agree\" with @<@:
--
-- * @x <= y@ = @not (y > x)@
-- * @x >= y@ = @not (y < x)@
--
-- Unlike in the non-linear setting, a linear @compare@ doesn't follow from
-- @<=@ since it requires calls: one to @<=@ and one to @==@. However,
-- from a linear @compare@ it is easy to implement the others. Hence, the
-- minimal complete definition only contains @compare@.
class Eq a => Ord a where
  {-# MINIMAL compare #-}

  -- | @compare x y@ returns an @Ordering@ which is
  -- one of @GT@ (greater than), @EQ@ (equal), or @LT@ (less than)
  -- which should be understood as \"x is @(compare x y)@ y\".
  compare :: a %1 -> a %1 -> Ordering

  -- /!\ `compare` doesn't have a specified fixity in base
  -- but we chose infix 4 for consistency with `elem`, <, <=, ==, /= ...
  infix 4 `compare`

  (<=) :: a %1 -> a %1 -> Bool
  a
x <= a
y = Bool %1 -> Bool
not (a
x forall a. Ord a => a %1 -> a %1 -> Bool
> a
y)
  infix 4 <= -- same fixity as base.<=

  (<) :: a %1 -> a %1 -> Bool
  a
x < a
y = forall a. Ord a => a %1 -> a %1 -> Ordering
compare a
x a
y forall a. Eq a => a %1 -> a %1 -> Bool
== Ordering
LT
  infix 4 < -- same fixity as base.<

  (>) :: a %1 -> a %1 -> Bool
  a
x > a
y = forall a. Ord a => a %1 -> a %1 -> Ordering
compare a
x a
y forall a. Eq a => a %1 -> a %1 -> Bool
== Ordering
GT
  infix 4 > -- same fixity as base.>

  (>=) :: a %1 -> a %1 -> Bool
  a
x >= a
y = Bool %1 -> Bool
not (a
x forall a. Ord a => a %1 -> a %1 -> Bool
< a
y)
  infix 4 >= -- same fixity as base.>=

-- | @max x y@ returns the larger input, or  'y'
-- in case of a tie.
max :: (Dupable a, Ord a) => a %1 -> a %1 -> a
max :: forall a. (Dupable a, Ord a) => a %1 -> a %1 -> a
max a
x a
y =
  forall a. Dupable a => a %1 -> (a, a)
dup2 a
x forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(a
x', a
x'') ->
    forall a. Dupable a => a %1 -> (a, a)
dup2 a
y forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(a
y', a
y'') ->
      if a
x' forall a. Ord a => a %1 -> a %1 -> Bool
<= a
y'
        then a
x'' forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` a
y''
        else a
y'' forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` a
x''

-- | @min x y@ returns the smaller input, or 'y'
-- in case of a tie.
min :: (Dupable a, Ord a) => a %1 -> a %1 -> a
min :: forall a. (Dupable a, Ord a) => a %1 -> a %1 -> a
min a
x a
y =
  forall a. Dupable a => a %1 -> (a, a)
dup2 a
x forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(a
x', a
x'') ->
    forall a. Dupable a => a %1 -> (a, a)
dup2 a
y forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(a
y', a
y'') ->
      if a
x' forall a. Ord a => a %1 -> a %1 -> Bool
<= a
y'
        then a
y'' forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` a
x''
        else a
x'' forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` a
y''

-- * Instances

instance Prelude.Ord a => Ord (Ur a) where
  Ur a
x compare :: Ur a %1 -> Ur a %1 -> Ordering
`compare` Ur a
y = a
x forall a. Ord a => a -> a -> Ordering
`Prelude.compare` a
y

instance (Consumable a, Ord a) => Ord (Prelude.Maybe a) where
  Maybe a
Prelude.Nothing compare :: Maybe a %1 -> Maybe a %1 -> Ordering
`compare` Maybe a
Prelude.Nothing = Ordering
EQ
  Maybe a
Prelude.Nothing `compare` Prelude.Just a
y = a
y forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Ordering
LT
  Prelude.Just a
x `compare` Maybe a
Prelude.Nothing = a
x forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Ordering
GT
  Prelude.Just a
x `compare` Prelude.Just a
y = a
x forall a. Ord a => a %1 -> a %1 -> Ordering
`compare` a
y

instance
  (Consumable a, Consumable b, Ord a, Ord b) =>
  Ord (Prelude.Either a b)
  where
  Prelude.Left a
x compare :: Either a b %1 -> Either a b %1 -> Ordering
`compare` Prelude.Right b
y = (a
x, b
y) forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Ordering
LT
  Prelude.Right b
x `compare` Prelude.Left a
y = (b
x, a
y) forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Ordering
GT
  Prelude.Left a
x `compare` Prelude.Left a
y = a
x forall a. Ord a => a %1 -> a %1 -> Ordering
`compare` a
y
  Prelude.Right b
x `compare` Prelude.Right b
y = b
x forall a. Ord a => a %1 -> a %1 -> Ordering
`compare` b
y

instance (Consumable a, Ord a) => Ord [a] where
  {-# SPECIALIZE instance Ord [Prelude.Char] #-}
  compare :: [a] %1 -> [a] %1 -> Ordering
compare [] [] = Ordering
EQ
  compare [a]
xs [] = [a]
xs forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Ordering
GT
  compare [] [a]
ys = [a]
ys forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Ordering
LT
  compare (a
x : [a]
xs) (a
y : [a]
ys) =
    forall a. Ord a => a %1 -> a %1 -> Ordering
compare a
x a
y forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \case
      Ordering
EQ -> forall a. Ord a => a %1 -> a %1 -> Ordering
compare [a]
xs [a]
ys
      Ordering
res -> ([a]
xs, [a]
ys) forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Ordering
res

instance (Ord a, Ord b) => Ord (a, b) where
  (a
a, b
b) compare :: (a, b) %1 -> (a, b) %1 -> Ordering
`compare` (a
a', b
b') =
    forall a. Ord a => a %1 -> a %1 -> Ordering
compare a
a a
a' forall a. Semigroup a => a %1 -> a %1 -> a
<> forall a. Ord a => a %1 -> a %1 -> Ordering
compare b
b b
b'

instance (Ord a, Ord b, Ord c) => Ord (a, b, c) where
  (a
a, b
b, c
c) compare :: (a, b, c) %1 -> (a, b, c) %1 -> Ordering
`compare` (a
a', b
b', c
c') =
    forall a. Ord a => a %1 -> a %1 -> Ordering
compare a
a a
a' forall a. Semigroup a => a %1 -> a %1 -> a
<> forall a. Ord a => a %1 -> a %1 -> Ordering
compare b
b b
b' forall a. Semigroup a => a %1 -> a %1 -> a
<> forall a. Ord a => a %1 -> a %1 -> Ordering
compare c
c c
c'

instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) where
  (a
a, b
b, c
c, d
d) compare :: (a, b, c, d) %1 -> (a, b, c, d) %1 -> Ordering
`compare` (a
a', b
b', c
c', d
d') =
    forall a. Ord a => a %1 -> a %1 -> Ordering
compare a
a a
a' forall a. Semigroup a => a %1 -> a %1 -> a
<> forall a. Ord a => a %1 -> a %1 -> Ordering
compare b
b b
b' forall a. Semigroup a => a %1 -> a %1 -> a
<> forall a. Ord a => a %1 -> a %1 -> Ordering
compare c
c c
c' forall a. Semigroup a => a %1 -> a %1 -> a
<> forall a. Ord a => a %1 -> a %1 -> Ordering
compare d
d d
d'

deriving via MovableOrd () instance Ord ()

deriving via MovableOrd Prelude.Int instance Ord Prelude.Int

deriving via MovableOrd Prelude.Double instance Ord Prelude.Double

deriving via MovableOrd Prelude.Bool instance Ord Prelude.Bool

deriving via MovableOrd Prelude.Char instance Ord Prelude.Char

deriving via MovableOrd Prelude.Ordering instance Ord Prelude.Ordering

deriving via MovableOrd Int16 instance Ord Int16

deriving via MovableOrd Int32 instance Ord Int32

deriving via MovableOrd Int64 instance Ord Int64

deriving via MovableOrd Int8 instance Ord Int8

deriving via MovableOrd Word16 instance Ord Word16

deriving via MovableOrd Word32 instance Ord Word32

deriving via MovableOrd Word64 instance Ord Word64

deriving via MovableOrd Word8 instance Ord Word8

newtype MovableOrd a = MovableOrd a

instance (Prelude.Eq a, Movable a) => Eq (MovableOrd a) where
  MovableOrd a
ar == :: MovableOrd a %1 -> MovableOrd a %1 -> Bool
== MovableOrd a
br =
    forall a. Movable a => a %1 -> Ur a
move (a
ar, a
br) forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur (a
a, a
b)) ->
      a
a forall a. Eq a => a -> a -> Bool
Prelude.== a
b

  MovableOrd a
ar /= :: MovableOrd a %1 -> MovableOrd a %1 -> Bool
/= MovableOrd a
br =
    forall a. Movable a => a %1 -> Ur a
move (a
ar, a
br) forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur (a
a, a
b)) ->
      a
a forall a. Eq a => a -> a -> Bool
Prelude./= a
b

instance (Prelude.Ord a, Movable a) => Ord (MovableOrd a) where
  MovableOrd a
ar compare :: MovableOrd a %1 -> MovableOrd a %1 -> Ordering
`compare` MovableOrd a
br =
    forall a. Movable a => a %1 -> Ur a
move (a
ar, a
br) forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur (a
a, a
b)) ->
      a
a forall a. Ord a => a -> a -> Ordering
`Prelude.compare` a
b