{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
-- editorconfig-checker-disable-file
{-# OPTIONS_GHC -fno-warn-orphans #-}

module PlutusTx.Ord (Ord (..), Ordering (..)) where

{-
We export off-chain Haskell's Ordering type as on-chain Plutus's Ordering type since they are the same.
-}

import PlutusTx.Bool (Bool (..))
import PlutusTx.Builtins qualified as Builtins
import PlutusTx.Either (Either (..))
import PlutusTx.Eq
import Prelude (Maybe (..), Ordering (..))

{- HLINT ignore -}

infix 4 <, <=, >, >=

-- Copied from the GHC definition

{-| The 'Ord' class is used for totally ordered datatypes.

Minimal complete definition: either 'compare' or '<='.
Using 'compare' can be more efficient for complex types. -}
class Eq a => Ord a where
  compare :: a -> a -> Ordering
  (<), (<=), (>), (>=) :: a -> a -> Bool
  max, min :: a -> a -> a

  {-# INLINEABLE compare #-}
  compare a
x a
y =
    if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
      then Ordering
EQ
      -- NB: must be '<=' not '<' to validate the
      -- above claim about the minimal things that
      -- can be defined for an instance of Ord:
      else
        if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
          then Ordering
LT
          else Ordering
GT

  {-# INLINEABLE (<) #-}
  a
x < a
y = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of Ordering
LT -> Bool
True; Ordering
_ -> Bool
False
  {-# INLINEABLE (<=) #-}
  a
x <= a
y = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of Ordering
GT -> Bool
False; Ordering
_ -> Bool
True
  {-# INLINEABLE (>) #-}
  a
x > a
y = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of Ordering
GT -> Bool
True; Ordering
_ -> Bool
False
  {-# INLINEABLE (>=) #-}
  a
x >= a
y = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of Ordering
LT -> Bool
False; Ordering
_ -> Bool
True

  -- These two default methods use '<=' rather than 'compare'
  -- because the latter is often more expensive
  {-# INLINEABLE max #-}
  max a
x a
y = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y then a
y else a
x
  {-# INLINEABLE min #-}
  min a
x a
y = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y then a
x else a
y
  {-# MINIMAL compare | (<=) #-}

instance Eq Ordering where
  {-# INLINEABLE (==) #-}
  Ordering
EQ == :: Ordering -> Ordering -> Bool
== Ordering
EQ = Bool
True
  Ordering
GT == Ordering
GT = Bool
True
  Ordering
LT == Ordering
LT = Bool
True
  Ordering
_ == Ordering
_ = Bool
False

instance Ord Builtins.Integer where
  {-# INLINEABLE (<) #-}
  < :: Integer -> Integer -> Bool
(<) = Integer -> Integer -> Bool
Builtins.lessThanInteger
  {-# INLINEABLE (<=) #-}
  <= :: Integer -> Integer -> Bool
(<=) = Integer -> Integer -> Bool
Builtins.lessThanEqualsInteger
  {-# INLINEABLE (>) #-}
  > :: Integer -> Integer -> Bool
(>) = Integer -> Integer -> Bool
Builtins.greaterThanInteger
  {-# INLINEABLE (>=) #-}
  >= :: Integer -> Integer -> Bool
(>=) = Integer -> Integer -> Bool
Builtins.greaterThanEqualsInteger

instance Ord Builtins.BuiltinByteString where
  {-# INLINEABLE (<) #-}
  < :: BuiltinByteString -> BuiltinByteString -> Bool
(<) = BuiltinByteString -> BuiltinByteString -> Bool
Builtins.lessThanByteString
  {-# INLINEABLE (<=) #-}
  <= :: BuiltinByteString -> BuiltinByteString -> Bool
(<=) = BuiltinByteString -> BuiltinByteString -> Bool
Builtins.lessThanEqualsByteString
  {-# INLINEABLE (>) #-}
  > :: BuiltinByteString -> BuiltinByteString -> Bool
(>) = BuiltinByteString -> BuiltinByteString -> Bool
Builtins.greaterThanByteString
  {-# INLINEABLE (>=) #-}
  >= :: BuiltinByteString -> BuiltinByteString -> Bool
(>=) = BuiltinByteString -> BuiltinByteString -> Bool
Builtins.greaterThanEqualsByteString

instance Ord a => Ord [a] where
  {-# INLINEABLE compare #-}
  compare :: [a] -> [a] -> Ordering
compare [] [] = Ordering
EQ
  compare [] (a
_ : [a]
_) = Ordering
LT
  compare (a
_ : [a]
_) [] = Ordering
GT
  compare (a
x : [a]
xs) (a
y : [a]
ys) =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
      Ordering
EQ -> [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [a]
xs [a]
ys
      Ordering
c -> Ordering
c

instance Ord Bool where
  {-# INLINEABLE compare #-}
  compare :: Bool -> Bool -> Ordering
compare Bool
b1 Bool
b2 = case Bool
b1 of
    Bool
False -> case Bool
b2 of
      Bool
False -> Ordering
EQ
      Bool
True -> Ordering
LT
    Bool
True -> case Bool
b2 of
      Bool
False -> Ordering
GT
      Bool
True -> Ordering
EQ

instance Ord a => Ord (Maybe a) where
  {-# INLINEABLE compare #-}
  compare :: Maybe a -> Maybe a -> Ordering
compare (Just a
a1) (Just a
a2) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a1 a
a2
  compare Maybe a
Nothing (Just a
_) = Ordering
LT
  compare (Just a
_) Maybe a
Nothing = Ordering
GT
  compare Maybe a
Nothing Maybe a
Nothing = Ordering
EQ

instance (Ord a, Ord b) => Ord (Either a b) where
  {-# INLINEABLE compare #-}
  compare :: Either a b -> Either a b -> Ordering
compare (Left a
a1) (Left a
a2) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a1 a
a2
  compare (Left a
_) (Right b
_) = Ordering
LT
  compare (Right b
_) (Left a
_) = Ordering
GT
  compare (Right b
b1) (Right b
b2) = b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
b1 b
b2

instance Ord () where
  {-# INLINEABLE compare #-}
  compare :: () -> () -> Ordering
compare ()
_ ()
_ = Ordering
EQ

instance (Ord a, Ord b) => Ord (a, b) where
  {-# INLINEABLE compare #-}
  compare :: (a, b) -> (a, b) -> Ordering
compare (a
a, b
b) (a
a', b
b') =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
a' of
      Ordering
EQ -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
b b
b'
      Ordering
c -> Ordering
c