------------------------------------------------------------------------
-- The Agda standard library
--
-- Sums of binary relations
------------------------------------------------------------------------

module Data.Sum.Relation.LeftOrder where

open import Data.Sum as Sum
import Data.Sum.Relation.Core as Core
open import Data.Sum.Relation.Pointwise as Pointwise using (Pointwise; ₁≁₂)
open import Data.Product
open import Data.Unit.Base using ()
open import Data.Empty
open import Function
open import Level
open import Relation.Nullary
import Relation.Nullary.Decidable as Dec
open import Relation.Binary
open import Relation.Binary.PropositionalEquality as P using (_≡_)

module _ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} where

  ----------------------------------------------------------------------
  -- Left order

  open Core public using (₁∼₂; ₁∼₁; ₂∼₂)

  infixr 1 _⊎-<_

  _⊎-<_ :  {ℓ₁ ℓ₂}  Rel A₁ ℓ₁  Rel A₂ ℓ₂  Rel (A₁  A₂) _
  _⊎-<_ = Core.⊎ʳ 

  ----------------------------------------------------------------------
  -- Some properties which are preserved by _⊎-<_

  module _ {ℓ₁ ℓ₂} {∼₁ : Rel A₁ ℓ₁} {∼₂ : Rel A₂ ℓ₂} where

    ⊎-<-refl : Reflexive ∼₁  Reflexive ∼₂ 
               Reflexive (∼₁ ⊎-< ∼₂)
    ⊎-<-refl refl₁ refl₂ = Core._⊎-refl_ refl₁ refl₂

    ⊎-<-transitive : Transitive ∼₁  Transitive ∼₂ 
                     Transitive (∼₁ ⊎-< ∼₂)
    ⊎-<-transitive trans₁ trans₂ = Core._⊎-transitive_ trans₁ trans₂

    ⊎-<-asymmetric : Asymmetric ∼₁  Asymmetric ∼₂ 
                     Asymmetric (∼₁ ⊎-< ∼₂)
    ⊎-<-asymmetric asym₁ asym₂ = asym₁ Core.⊎-asymmetric asym₂

    ⊎-<-total : Total ∼₁  Total ∼₂  Total (∼₁ ⊎-< ∼₂)
    ⊎-<-total total₁ total₂ = total
      where
      total : Total (_ ⊎-< _)
      total (inj₁ x) (inj₁ y) = Sum.map ₁∼₁ ₁∼₁ $ total₁ x y
      total (inj₂ x) (inj₂ y) = Sum.map ₂∼₂ ₂∼₂ $ total₂ x y
      total (inj₁ x) (inj₂ y) = inj₁ (₁∼₂ _)
      total (inj₂ x) (inj₁ y) = inj₂ (₁∼₂ _)

    ⊎-<-decidable : Decidable ∼₁  Decidable ∼₂ 
                  (∀ {x y}  Dec (inj₁ x  ∼₁ ⊎-< ∼₂  inj₂ y)) 
                  Decidable (∼₁ ⊎-< ∼₂)
    ⊎-<-decidable dec₁ dec₂ dec₁₂ = Core.⊎-decidable dec₁ dec₂ dec₁₂


  module _ {ℓ₁ ℓ₂} {∼₁ : Rel A₁ ℓ₁} {≈₁ : Rel A₁ ℓ₂}
           {ℓ₃ ℓ₄} {∼₂ : Rel A₂ ℓ₃} {≈₂ : Rel A₂ ℓ₄} where

    ⊎-<-reflexive : ≈₁  ∼₁  ≈₂  ∼₂ 
                    (Pointwise ≈₁ ≈₂)  (∼₁ ⊎-< ∼₂)
    ⊎-<-reflexive refl₁ refl₂ = refl₁ Core.⊎-reflexive refl₂

    ⊎-<-irreflexive : Irreflexive ≈₁ ∼₁  Irreflexive ≈₂ ∼₂ 
                      Irreflexive (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂)
    ⊎-<-irreflexive irrefl₁ irrefl₂ = irrefl₁ Core.⊎-irreflexive irrefl₂

    ⊎-<-antisymmetric : Antisymmetric ≈₁ ∼₁  Antisymmetric ≈₂ ∼₂ 
                        Antisymmetric (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂)
    ⊎-<-antisymmetric antisym₁ antisym₂ = antisym₁ Core.⊎-antisymmetric antisym₂

    ⊎-<-respects₂ : ∼₁ Respects₂ ≈₁  ∼₂ Respects₂ ≈₂ 
                    (∼₁ ⊎-< ∼₂) Respects₂ (Pointwise ≈₁ ≈₂)
    ⊎-<-respects₂ resp₁ resp₂ = Core._⊎-≈-respects₂_ resp₁ resp₂

    ⊎-<-trichotomous : Trichotomous ≈₁ ∼₁  Trichotomous ≈₂ ∼₂ 
                         Trichotomous (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂)
    ⊎-<-trichotomous tri₁ tri₂ = tri
      where
      tri : Trichotomous (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂)
      tri (inj₁ x) (inj₂ y) = tri< (₁∼₂ _) ₁≁₂ (λ())
      tri (inj₂ x) (inj₁ y) = tri> (λ()) (λ()) (₁∼₂ _)
      tri (inj₁ x) (inj₁ y) with tri₁ x y
      ... | tri< x<y x≉y x≯y =
        tri< (₁∼₁ x<y) (x≉y  Core.drop-inj₁) (x≯y  Core.drop-inj₁)
      ... | tri≈ x≮y x≈y x≯y =
        tri≈ (x≮y  Core.drop-inj₁) (₁∼₁ x≈y) (x≯y  Core.drop-inj₁)
      ... | tri> x≮y x≉y x>y =
        tri> (x≮y  Core.drop-inj₁) (x≉y  Core.drop-inj₁) (₁∼₁ x>y)
      tri (inj₂ x) (inj₂ y) with tri₂ x y
      ... | tri< x<y x≉y x≯y =
        tri< (₂∼₂ x<y) (x≉y  Core.drop-inj₂) (x≯y  Core.drop-inj₂)
      ... | tri≈ x≮y x≈y x≯y =
        tri≈ (x≮y  Core.drop-inj₂) (₂∼₂ x≈y) (x≯y  Core.drop-inj₂)
      ... | tri> x≮y x≉y x>y =
        tri> (x≮y  Core.drop-inj₂) (x≉y  Core.drop-inj₂) (₂∼₂ x>y)

  ----------------------------------------------------------------------
  -- Some collections of properties which are preserved

  module _ {ℓ₁ ℓ₂} {≈₁ : Rel A₁ ℓ₁} {∼₁ : Rel A₁ ℓ₂}
           {ℓ₃ ℓ₄} {≈₂ : Rel A₂ ℓ₃} {∼₂ : Rel A₂ ℓ₄} where

    ⊎-<-isPreorder : IsPreorder ≈₁ ∼₁  IsPreorder ≈₂ ∼₂ 
                     IsPreorder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂)
    ⊎-<-isPreorder pre₁ pre₂ = record
      { isEquivalence =
          Pointwise.⊎-isEquivalence (isEquivalence pre₁) (isEquivalence pre₂)
      ; reflexive     = ⊎-<-reflexive (reflexive pre₁) (reflexive pre₂)
      ; trans         = ⊎-<-transitive (trans pre₁) (trans pre₂)
      }
      where open IsPreorder

    ⊎-<-isPartialOrder : IsPartialOrder ≈₁ ∼₁ 
                         IsPartialOrder ≈₂ ∼₂ 
                         IsPartialOrder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂)
    ⊎-<-isPartialOrder po₁ po₂ = record
      { isPreorder = ⊎-<-isPreorder (isPreorder po₁) (isPreorder po₂)
      ; antisym    = ⊎-<-antisymmetric (antisym po₁) (antisym    po₂)
      }
      where open IsPartialOrder

    ⊎-<-isStrictPartialOrder : IsStrictPartialOrder ≈₁ ∼₁ 
                               IsStrictPartialOrder ≈₂ ∼₂ 
                               IsStrictPartialOrder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂)
    ⊎-<-isStrictPartialOrder spo₁ spo₂ = record
      { isEquivalence = Pointwise.⊎-isEquivalence (isEquivalence spo₁) (isEquivalence spo₂)
      ; irrefl        = ⊎-<-irreflexive   (irrefl spo₁) (irrefl   spo₂)
      ; trans         = ⊎-<-transitive    (trans spo₁)  (trans    spo₂)
      ; <-resp-≈      = ⊎-<-respects₂   (<-resp-≈ spo₁) (<-resp-≈ spo₂)
      }
      where open IsStrictPartialOrder

    ⊎-<-isTotalOrder : IsTotalOrder ≈₁ ∼₁ 
                       IsTotalOrder ≈₂ ∼₂ 
                       IsTotalOrder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂)
    ⊎-<-isTotalOrder to₁ to₂ = record
      { isPartialOrder = ⊎-<-isPartialOrder (isPartialOrder to₁) (isPartialOrder to₂)
      ; total          = ⊎-<-total (total to₁) (total to₂)
      }
      where open IsTotalOrder

    ⊎-<-isDecTotalOrder : IsDecTotalOrder ≈₁ ∼₁ 
                          IsDecTotalOrder ≈₂ ∼₂ 
                          IsDecTotalOrder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂)
    ⊎-<-isDecTotalOrder to₁ to₂ = record
      { isTotalOrder = ⊎-<-isTotalOrder (isTotalOrder to₁) (isTotalOrder to₂)
      ; _≟_          = Pointwise.⊎-decidable (_≟_  to₁) (_≟_  to₂)
      ; _≤?_         = ⊎-<-decidable (_≤?_ to₁) (_≤?_ to₂) (yes (₁∼₂ _))
      }
      where open IsDecTotalOrder

    ⊎-<-isStrictTotalOrder : IsStrictTotalOrder ≈₁ ∼₁ 
                             IsStrictTotalOrder ≈₂ ∼₂ 
                             IsStrictTotalOrder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂)
    ⊎-<-isStrictTotalOrder sto₁ sto₂ = record
      { isEquivalence = Pointwise.⊎-isEquivalence (isEquivalence sto₁) (isEquivalence sto₂)
      ; trans         = ⊎-<-transitive (trans sto₁) (trans sto₂)
      ; compare       = ⊎-<-trichotomous (compare sto₁) (compare sto₂)
      }
      where open IsStrictTotalOrder

------------------------------------------------------------------------
-- "Packages" can also be combined.

module _ {a b c d e f} where

  ⊎-<-preorder : Preorder a b c 
                 Preorder d e f 
                 Preorder _ _ _
  ⊎-<-preorder p₁ p₂ = record
    { isPreorder   =
        ⊎-<-isPreorder (isPreorder p₁) (isPreorder p₂)
    } where open Preorder

  ⊎-<-poset : Poset a b c 
              Poset a b c 
              Poset _ _ _
  ⊎-<-poset po₁ po₂ = record
    { isPartialOrder =
        ⊎-<-isPartialOrder (isPartialOrder po₁) (isPartialOrder po₂)
    } where open Poset

  ⊎-<-strictPartialOrder : StrictPartialOrder a b c 
                           StrictPartialOrder d e f 
                           StrictPartialOrder _ _ _
  ⊎-<-strictPartialOrder spo₁ spo₂ = record
    { isStrictPartialOrder =
      ⊎-<-isStrictPartialOrder (isStrictPartialOrder spo₁) (isStrictPartialOrder spo₂)
    } where open StrictPartialOrder

  ⊎-<-totalOrder : TotalOrder a b c 
                   TotalOrder d e f 
                   TotalOrder _ _ _
  ⊎-<-totalOrder to₁ to₂ = record
    { isTotalOrder = ⊎-<-isTotalOrder (isTotalOrder to₁) (isTotalOrder to₂)
    } where open TotalOrder

  ⊎-<-decTotalOrder : DecTotalOrder a b c 
                      DecTotalOrder d e f 
                      DecTotalOrder _ _ _
  ⊎-<-decTotalOrder to₁ to₂ = record
    { isDecTotalOrder = ⊎-<-isDecTotalOrder (isDecTotalOrder to₁) (isDecTotalOrder to₂)
    } where open DecTotalOrder

  ⊎-<-strictTotalOrder : StrictTotalOrder a b c 
                         StrictTotalOrder a b c 
                         StrictTotalOrder _ _ _
  ⊎-<-strictTotalOrder sto₁ sto₂ = record
    { isStrictTotalOrder = ⊎-<-isStrictTotalOrder (isStrictTotalOrder sto₁) (isStrictTotalOrder sto₂)
    } where open StrictTotalOrder