{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
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

    {-# INLINABLE 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

    {-# INLINABLE (<) #-}
    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 }
    {-# INLINABLE (<=) #-}
    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 }
    {-# INLINABLE (>) #-}
    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 }
    {-# INLINABLE (>=) #-}
    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
    {-# INLINABLE 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
    {-# INLINABLE 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

instance Eq Ordering where
    {-# INLINABLE (==) #-}
    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
    {-# INLINABLE (<) #-}
    < :: Integer -> Integer -> Bool
(<) = Integer -> Integer -> Bool
Builtins.lessThanInteger
    {-# INLINABLE (<=) #-}
    <= :: Integer -> Integer -> Bool
(<=) = Integer -> Integer -> Bool
Builtins.lessThanEqualsInteger
    {-# INLINABLE (>) #-}
    > :: Integer -> Integer -> Bool
(>) = Integer -> Integer -> Bool
Builtins.greaterThanInteger
    {-# INLINABLE (>=) #-}
    >= :: Integer -> Integer -> Bool
(>=) = Integer -> Integer -> Bool
Builtins.greaterThanEqualsInteger

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

instance Ord a => Ord [a] where
    {-# INLINABLE 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
    {-# INLINABLE 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
    {-# INLINABLE 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
    {-# INLINABLE 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
    {-# INLINABLE compare #-}
    compare :: () -> () -> Ordering
compare ()
_ ()
_ = Ordering
EQ

instance (Ord a, Ord b) => Ord (a, b) where
    {-# INLINABLE 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