content: {-# 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
    x <= y = not (x > y)
    infix 4 <= -- same fixity as base.<=
  
    (<) :: a %1 -> a %1 -> Bool
    x < y = compare x y == LT
    infix 4 < -- same fixity as base.<
  
    (>) :: a %1 -> a %1 -> Bool
    x > y = compare x y == GT
    infix 4 > -- same fixity as base.>
  
    (>=) :: a %1 -> a %1 -> Bool
    x >= y = not (x < 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 x y =
    dup2 x & \(x', x'') ->
      dup2 y & \(y', y'') ->
        if x' <= y'
          then x'' `lseq` y''
          else y'' `lseq` 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 x y =
    dup2 x & \(x', x'') ->
      dup2 y & \(y', y'') ->
        if x' <= y'
          then y'' `lseq` x''
          else x'' `lseq` y''
  
  -- * Instances
  
  instance (Prelude.Ord a) => Ord (Ur a) where
    Ur x `compare` Ur y = x `Prelude.compare` y
  
  instance (Consumable a, Ord a) => Ord (Prelude.Maybe a) where
    Prelude.Nothing `compare` Prelude.Nothing = EQ
    Prelude.Nothing `compare` Prelude.Just y = y `lseq` LT
    Prelude.Just x `compare` Prelude.Nothing = x `lseq` GT
    Prelude.Just x `compare` Prelude.Just y = x `compare` y
  
  instance
    (Consumable a, Consumable b, Ord a, Ord b) =>
    Ord (Prelude.Either a b)
    where
    Prelude.Left x `compare` Prelude.Right y = (x, y) `lseq` LT
    Prelude.Right x `compare` Prelude.Left y = (x, y) `lseq` GT
    Prelude.Left x `compare` Prelude.Left y = x `compare` y
    Prelude.Right x `compare` Prelude.Right y = x `compare` y
  
  instance (Consumable a, Ord a) => Ord [a] where
    {-# SPECIALIZE instance Ord [Prelude.Char] #-}
    compare [] [] = EQ
    compare xs [] = xs `lseq` GT
    compare [] ys = ys `lseq` LT
    compare (x : xs) (y : ys) =
      case compare x y of
        EQ -> compare xs ys
        res -> (xs, ys) `lseq` res
  
  instance (Ord a, Ord b) => Ord (a, b) where
    (a, b) `compare` (a', b') =
      compare a a' <> compare b b'
  
  instance (Ord a, Ord b, Ord c) => Ord (a, b, c) where
    (a, b, c) `compare` (a', b', c') =
      compare a a' <> compare b b' <> compare c c'
  
  instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) where
    (a, b, c, d) `compare` (a', b', c', d') =
      compare a a' <> compare b b' <> compare c c' <> compare 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 ar == MovableOrd br =
      move (ar, br) & \(Ur (a, b)) ->
        a Prelude.== b
  
    MovableOrd ar /= MovableOrd br =
      move (ar, br) & \(Ur (a, b)) ->
        a Prelude./= b
  
  instance (Prelude.Ord a, Movable a) => Ord (MovableOrd a) where
    MovableOrd ar `compare` MovableOrd br =
      move (ar, br) & \(Ur (a, b)) ->
        a `Prelude.compare` b
  