module Haskell.RangedSets.RangedSet where
open import Agda.Builtin.Equality

open import Haskell.Prim
open import Haskell.Prim.Ord
open import Haskell.Prim.Bool
open import Haskell.Prim.Maybe
open import Haskell.Prim.Enum
open import Haskell.Prim.Num
open import Haskell.Prim.Eq
open import Haskell.Prim.Foldable
open import Haskell.Prim.Monoid
open import Haskell.Prim.Int
open import Haskell.Prim.List
open import Haskell.Prim.Integer
open import Haskell.Prim.Real

open import Haskell.RangedSets.Boundaries
open import Haskell.RangedSets.Ranges
open import Haskell.RangedSetsProp.library
open import Haskell.RangedSetsProp.BoundariesProperties

{-# FOREIGN AGDA2HS
import Haskell.RangedSets.Boundaries
#-}
{-# FOREIGN AGDA2HS
import Haskell.RangedSets.Ranges
#-}
{-# FOREIGN AGDA2HS
import Data.List
#-}

infixl 7 _-/\-_
infixl 6 _-\/-_ _-!-_
infixl 5 _-<=-_ _-<-_ _-?-_

okAdjacent : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Range a → Range a → Bool
okAdjacent r@(Rg lower1 upper1) r2@(Rg lower2 upper2) = rangeLower r <= rangeUpper r && rangeUpper r <= rangeLower r2 && rangeLower r2 <= rangeUpper r2
{-# COMPILE AGDA2HS okAdjacent #-}

validRangeList : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → List (Range a) → Bool
validRangeList [] = true
validRangeList (x ∷ []) = (rangeLower x) <= (rangeUpper x)
validRangeList (x ∷ rs@(r1 ∷ rss)) = (okAdjacent x r1) && (validRangeList rs)
{-# COMPILE AGDA2HS validRangeList #-}

validBoundaryList : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → List (Boundary a) → Bool
validBoundaryList [] = true
validBoundaryList (x ∷ []) = true
validBoundaryList (x ∷ rs@(r1 ∷ rss)) = (x <= r1) && (validBoundaryList rs)

data RSet (a : Set) ⦃ o : Ord a ⦄ ⦃ dio : DiscreteOrdered a ⦄ : Set where
    RS : (rg : List (Range a)) → {IsTrue (validRangeList rg)} → RSet a

{-# COMPILE AGDA2HS RSet #-}

rSetRanges : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → RSet a → List (Range a)
rSetRanges (RS ranges) = ranges
{-# COMPILE AGDA2HS rSetRanges #-}

overlap1 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Range a → Range a → Bool
overlap1 (Rg _ upper1) (Rg lower2 _) = (upper1 >= lower2)
{-# COMPILE AGDA2HS overlap1 #-}

sortedRangeList : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → List (Range a) → Bool
sortedRangeList [] = true
sortedRangeList (r ∷ []) = true
sortedRangeList (r1 ∷ r2 ∷ rs) = (r1 <= r2) && (sortedRangeList (r2 ∷ rs))

validRanges : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → List (Range a) → Bool
validRanges [] = true
validRanges (r ∷ rs) = (rangeLower r <= rangeUpper r) && (validRanges rs)

headandtailSorted : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : List (Range a))
      → ⦃ ne : NonEmpty rs ⦄ → (IsTrue (sortedRangeList rs))
      → (IsTrue (sortedRangeList (tail rs ⦃ ne ⦄)))
headandtailValidRanges : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : List (Range a))
      → ⦃ ne : NonEmpty rs ⦄ → (IsTrue (validRanges rs))
      → (IsTrue (validRanges (tail rs ⦃ ne ⦄)))

normalise : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rg : List (Range a))
   → ⦃ IsTrue (sortedRangeList rg) ⦄
   → ⦃ IsTrue (validRanges rg) ⦄
   → List (Range a)

postulate
   sortedList : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : List (Range a))
      -> IsTrue (sortedRangeList (sort (filter (λ r → (rangeIsEmpty r) == false) rs)))

   validRangesList : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : List (Range a))
      -> IsTrue (validRanges (sort (filter (λ r → (rangeIsEmpty r) == false) rs)))

unsafeRangedSet : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                → (rg : List (Range a))
                → ⦃ IsTrue (validRangeList ⦃ o ⦄ ⦃ dio ⦄ rg) ⦄ → RSet a
unsafeRangedSet rs ⦃ prf ⦄  = RS rs {prf}

{-# COMPILE AGDA2HS unsafeRangedSet #-}

validFunction2 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (b : Boundary a) → (f : Boundary a → Boundary a) → Bool
validFunction2 b f = (f b) > b

validFunction : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (b : Boundary a) → (g : Boundary a → Maybe (Boundary a)) → Bool
validFunction b g with (g b)
...                       | Nothing = true
...                       | Just b2 = (b2 > b)

ranges3 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ →
      Maybe (Boundary a) → (f : Boundary a → Boundary a) → (g : Boundary a → Maybe (Boundary a))
      → List (Range a)
{-# TERMINATING #-}
ranges2 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (b : Boundary a)
      → (f : Boundary a → Boundary a) → (g : Boundary a → Maybe (Boundary a))
      → List (Range a)
ranges2 b upperFunc succFunc = (Rg b (upperFunc b)) ∷ (ranges3 (succFunc b) upperFunc succFunc)

ranges3 (Just b1) upperFunc succFunc = if ((validFunction2 b1 upperFunc) && (validFunction b1 succFunc)) then
                              (ranges2 b1 upperFunc succFunc) else []
ranges3 Nothing _ _ = []
{-# COMPILE AGDA2HS ranges2 #-}
{-# COMPILE AGDA2HS ranges3 #-}

setBounds1 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (xs : List (Boundary a))
   → List (Boundary a)
setBounds1 (BoundaryBelowAll ∷ xs) = xs
setBounds1 xs = (BoundaryBelowAll ∷ xs)
{-# COMPILE AGDA2HS setBounds1 #-}

bounds1 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
         → List (Range a) → List (Boundary a)
bounds1 (r ∷ rs) = (rangeLower r) ∷ (rangeUpper r) ∷ (bounds1 rs)
bounds1 [] = []
{-# COMPILE AGDA2HS bounds1 #-}

ranges1 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → List (Boundary a)
   → List (Range a)
ranges1 (b1 ∷ b2 ∷ bs) = (Rg b1 b2) ∷ (ranges1 bs)
ranges1 (BoundaryAboveAll ∷ [])  = []
ranges1 (b ∷ []) = (Rg b BoundaryAboveAll) ∷ []
ranges1 _ = []
{-# COMPILE AGDA2HS ranges1 #-}

merge1 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → List (Range a) → List (Range a) → List (Range a)
merge1 [] [] = []
merge1 ms1@(h1 ∷ t1) [] = ms1
merge1 [] ms2@(h2 ∷ t2) = ms2
merge1 ms1@(h1 ∷ t1) ms2@(h2 ∷ t2) = if_then_else_ (h1 < h2) (h1 ∷ (merge1 t1 ms2)) (h2 ∷ (merge1 ms1 t2))
{-# COMPILE AGDA2HS merge1 #-}

merge2 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
   → List (Range a) → List (Range a) → List (Range a)
merge2 [] [] = []
merge2 ms1@(h1 ∷ t1) [] = []
merge2 [] ms2@(h2 ∷ t2) = []
merge2 ms1@(h1 ∷ t1) ms2@(h2 ∷ t2) =
   (rangeIntersection h1 h2) ∷
   (if_then_else_ (rangeUpper h1 < rangeUpper h2) (merge2 t1 ms2) (merge2 ms1 t2))
{-# COMPILE AGDA2HS merge2 #-}

postulate

   sortedListComposed : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
            → (r1 r2 : Range a) → (ranges : List (Range a))
            → IsTrue (sortedRangeList (r1 ∷ r2 ∷ ranges))
            → IsTrue (sortedRangeList ((Rg (rangeLower r1) (max (rangeUpper r1) (rangeUpper r2))) ∷ ranges))

   validRangesComposed : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
            → (r1 r2 : Range a) → (ranges : List (Range a))
            → IsTrue (sortedRangeList (r1 ∷ r2 ∷ ranges))
            → IsTrue (validRanges (r1 ∷ r2 ∷ ranges))
            → IsTrue (validRanges ((Rg (rangeLower r1) (max (rangeUpper r1) (rangeUpper r2))) ∷ ranges))

   rangesLTEQ : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                          → (b : Boundary a)
                          → (f : Boundary a → Boundary a) → IsTrue (f b > b) → IsTrue (b <= f b)

   stupid1 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                          → (b b1 : Boundary a)
                          → (f : Boundary a → Boundary a)
                          → (g : Boundary a → Maybe (Boundary a))
                          → IsTrue (validFunction2 b f) → IsTrue (validFunction b g)
                          → (cond : Bool) -- this condition is (validFunction2 b1 f) && (validFunction b1 g)
                          → IsTrue cond
                          → IsTrue (validFunction2 b1 f)
   stupid2 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                          → (b b1 : Boundary a)
                          → (f : Boundary a → Boundary a)
                          → (g : Boundary a → Maybe (Boundary a))
                          → IsTrue (validFunction2 b f) → IsTrue (validFunction b g)
                          → (cond : Bool) -- this condition is (validFunction2 b1 f) && (validFunction b1 g)
                          → IsTrue cond
                          → IsTrue (validFunction b1 g)

   -- used only when h <= h3
   okSorted : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (h h3 : Range a)
         → sortedRangeList (h ∷ h3 ∷ []) ≡ true

   -- holds only when upper h <= lower(head ms)
   validList : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (h : Range a) → (ms : List (Range a))
         → IsTrue (validRangeList ms)
         → validRangeList (h ∷ ms) ≡ true

   validIsSorted :  ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (ms : List (Range a))
                     → IsTrue (validRangeList ms) → IsTrue (sortedRangeList ms)

   -- holds only when h < (head ms)
   validSortedList : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (h : Range a) → (ms : List (Range a))
         → IsTrue (sortedRangeList ms)
         → sortedRangeList (h ∷ ms) ≡ true

normalise (r1 ∷ r2 ∷ rs) ⦃ prf ⦄ ⦃ prf2 ⦄ =
   if_then_else_ (overlap1 r1 r2)
      (normalise ((Rg (rangeLower r1) (max (rangeUpper r1) (rangeUpper r2))) ∷ rs)
      ⦃ sortedListComposed r1 r2 rs prf ⦄ ⦃ validRangesComposed r1 r2 rs prf prf2 ⦄ )
         (r1 ∷ (normalise (r2 ∷ rs) ⦃ headandtailSorted (r1 ∷ r2 ∷ rs) prf ⦄ ⦃ headandtailValidRanges (r1 ∷ r2 ∷ rs) prf2 ⦄ ))
normalise rs = rs
{-# COMPILE AGDA2HS normalise #-}

-- some useful proofs
headandtail : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a)
      → ⦃ ne : NonEmpty (rSetRanges rs) ⦄ → (IsTrue (validRangeList (rSetRanges rs)))
      → (IsTrue (validRangeList (tail (rSetRanges rs) ⦃ ne ⦄)))
okAdjValid : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : List (Range a)) → (r : Range a)
      → ⦃ ne : NonEmpty rs ⦄ → (IsTrue (validRangeList (r ∷ rs))) → IsTrue (okAdjacent r (head rs ⦃ ne ⦄))
headandtail2 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : List (Range a))
      → ⦃ ne : NonEmpty rs ⦄ → (IsTrue (validRangeList rs))
      → (IsTrue (validRangeList (tail rs ⦃ ne ⦄)))
tailandhead : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a)
      → ⦃ ne : NonEmpty (rSetRanges rs) ⦄ → (IsTrue (validRangeList (rSetRanges rs)))
      → (IsTrue (validRangeList ((head (rSetRanges rs) ⦃ ne ⦄) ∷ [])))
tailandhead2 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : List (Range a))
      → ⦃ ne : NonEmpty rs ⦄ → (IsTrue (validRangeList rs))
      → (IsTrue (validRangeList ((head rs ⦃ ne ⦄) ∷ [])))

okAdjIsTrue :  ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (r : Range a) → (r2 : Range a)
               → okAdjacent r r2 ≡ ((rangeLower r <= rangeUpper r) && (rangeUpper r <= rangeLower r2) && (rangeLower r2 <= rangeUpper r2))

normalisedSortedList0 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
         → (ms : List (Range a))
         → (prf : IsTrue (sortedRangeList ms))
         → (prf2 : IsTrue (validRanges ms))
         → validRangeList (normalise ms ⦃ prf ⦄ ⦃ prf2 ⦄) ≡ true

normalisedSortedList00 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
         → (rs : List (Range a))
         → (r1 r2 : Range a) → (prf : IsTrue (sortedRangeList (r1 ∷ r2 ∷ rs))) → (prf2 : IsTrue (validRanges (r1 ∷ r2 ∷ rs)))
         → (b : Bool)
         → validRangeList (if_then_else_ b
      (normalise ((Rg (rangeLower r1) (max (rangeUpper r1) (rangeUpper r2))) ∷ rs) ⦃ sortedListComposed r1 r2 rs prf ⦄ ⦃ validRangesComposed r1 r2 rs prf prf2 ⦄)
         (r1 ∷ (normalise (r2 ∷ rs) ⦃ headandtailSorted (r1 ∷ r2 ∷ rs) prf ⦄ ⦃ headandtailValidRanges (r1 ∷ r2 ∷ rs) prf2 ⦄))) ≡ true

normalisedSortedList : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
  → (ms : List (Range a))
  → (prf : IsTrue (sortedRangeList ms))
  → (prf2 : IsTrue (validRanges ms))
  → IsTrue (validRangeList (normalise ms ⦃ prf ⦄ ⦃ prf2 ⦄))

merge1HasValidRanges0 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                          → (rs1 rs2 : RSet a)
                          → IsTrue (validRangeList (rSetRanges rs1)) → IsTrue (validRangeList (rSetRanges rs2))
                          → (validRanges (merge1 (rSetRanges rs1) (rSetRanges rs2))) ≡ true

merge1HasValidRanges00 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                          → (rs1 rs2 : RSet a) → (h1 h2 : Range a)
                          → IsTrue (validRangeList (h1 ∷ (rSetRanges rs1))) → IsTrue (validRangeList (h2 ∷ (rSetRanges rs2)))
                          → (b : Bool)
                          → validRanges (if_then_else_ b
                          (h1 ∷ (merge1 (rSetRanges rs1) (h2 ∷ (rSetRanges rs2))))
                          (h2 ∷ (merge1 (h1 ∷ (rSetRanges rs1)) (rSetRanges rs2)))) ≡ true

validListMeansValidRanges : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                          → (rs1 : RSet a)
                          → IsTrue (validRangeList (rSetRanges rs1))
                          → (validRanges (rSetRanges rs1)) ≡ true

merge1HasValidRanges : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
   → (rs1 rs2 : RSet a)
   → IsTrue (validRangeList (rSetRanges rs1))
   → IsTrue (validRangeList (rSetRanges rs2))
   → IsTrue (validRanges (merge1 (rSetRanges rs1) (rSetRanges rs2)))

ranges2HasValidRanges0 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                          → (b : Boundary a)
                          → (f : Boundary a → Boundary a)
                          → (g : Boundary a → Maybe (Boundary a))
                          → IsTrue (validFunction2 b f) → IsTrue (validFunction b g)
                          → (validRanges (ranges2 b f g)) ≡ true
ranges2HasValidRanges00 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                          → (b : Boundary a)
                          → (f : Boundary a → Boundary a)
                          → (g : Boundary a → Maybe (Boundary a))
                          → (mb : Maybe (Boundary a))
                          → IsTrue (validFunction2 b f) → IsTrue (validFunction b g)
                          → (validRanges ((Rg b (f b)) ∷ (ranges3 mb f g))) ≡ true
ranges2HasValidRanges000 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                          → (b b1 : Boundary a)
                          → (f : Boundary a → Boundary a)
                          → (g : Boundary a → Maybe (Boundary a))
                          → (cond : Bool)
                          → IsTrue (validFunction2 b f) → IsTrue (validFunction b g)
                          → (validRanges ((Rg b (f b)) ∷ (if cond then (ranges2 b1 f g) else []))) ≡ true

ranges2HasValidRanges : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
                          → (b : Boundary a)
                          → (f : Boundary a → Boundary a)
                          → (g : Boundary a → Maybe (Boundary a))
                          → IsTrue (validFunction2 b f) → IsTrue (validFunction b g)
                          → IsTrue (validRanges (ranges2 b f g))

unfoldSorted : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (b : Boundary a)
            → (f : Boundary a → Boundary a)
            → (g : Boundary a → Maybe (Boundary a))
            → IsTrue (sortedRangeList (ranges2 b f g))

unfoldIsSorted00 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (b : Boundary a)
            → (f : Boundary a → Boundary a)
            → (g : Boundary a → Maybe (Boundary a))
            → (b1 : Boundary a) → (cond : Bool)
            → sortedRangeList ((Rg b (f b)) ∷ (if_then_else_ cond (ranges2 b1 f g) [])) ≡ true

unfoldIsSorted0 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (b : Boundary a)
            → (f : Boundary a → Boundary a)
            → (g : Boundary a → Maybe (Boundary a))
            → (mb : Maybe (Boundary a)) → sortedRangeList ((Rg b (f b)) ∷ (ranges3 mb f g)) ≡ true

unfoldIsSorted : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (b : Boundary a)
            → (f : Boundary a → Boundary a)
            → (g : Boundary a → Maybe (Boundary a))
            → sortedRangeList (ranges2 b f g) ≡ true

-- the following proofs are used for proving that intersection is valid
intersection2 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs1 : RSet a) → (rs2 : RSet a)
                  → ⦃ ne1 : NonEmpty (rSetRanges rs1) ⦄ → ⦃ ne2 : NonEmpty (rSetRanges rs2) ⦄
                  → IsTrue (validRangeList (rSetRanges rs1)) → IsTrue (validRangeList (rSetRanges rs2))
                  → (b : Bool)
                  →     validRangeList (
       if_then_else_ b

      ((rangeIntersection (head (rSetRanges rs1) ⦃ ne1 ⦄) (head (rSetRanges rs2) ⦃ ne2 ⦄))
      ∷ (filter (λ x → (rangeIsEmpty x == false))
       (if_then_else_ (rangeUpper (head (rSetRanges rs1) ⦃ ne1 ⦄) < rangeUpper (head (rSetRanges rs2) ⦃ ne2 ⦄))
        (merge2 (tail (rSetRanges rs1) ⦃ ne1 ⦄) (rSetRanges rs2))
        (merge2 (rSetRanges rs1) (tail (rSetRanges rs2) ⦃ ne2 ⦄)))))

       (filter (λ x → (rangeIsEmpty x == false))
         (if_then_else_ (rangeUpper (head (rSetRanges rs1) ⦃ ne1 ⦄) < rangeUpper (head (rSetRanges rs2) ⦃ ne2 ⦄))
          (merge2 (tail (rSetRanges rs1) ⦃ ne1 ⦄) (rSetRanges rs2))
          (merge2 (rSetRanges rs1) (tail (rSetRanges rs2) ⦃ ne2 ⦄)))) ) ≡ true
intersection3 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs1 : RSet a) → (rs2 : RSet a)
                  → ⦃ ne1 : NonEmpty (rSetRanges rs1) ⦄ → ⦃ ne2 : NonEmpty (rSetRanges rs2) ⦄
                  → IsTrue (validRangeList (rSetRanges rs1)) → IsTrue (validRangeList (rSetRanges rs2))
                  → (b : Bool)
                  → validRangeList ((filter (λ x → (rangeIsEmpty x == false))
                        (if_then_else_ b
                           (merge2 (tail (rSetRanges rs1) ⦃ ne1 ⦄) (rSetRanges rs2))
                           (merge2 (rSetRanges rs1) (tail (rSetRanges rs2) ⦃ ne2 ⦄))))) ≡ true

intersectionHolds : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs1 : RSet a) → (rs2 : RSet a)
                  → IsTrue (validRangeList (rSetRanges rs1)) → IsTrue (validRangeList (rSetRanges rs2))
                  → validRangeList (filter (λ x → (rangeIsEmpty x == false)) (merge2 (rSetRanges rs1) (rSetRanges rs2))) ≡ true

-- intersection of two valid ranged sets is also valid range set
intersection0 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs1 : RSet a) → (rs2 : RSet a)
      → IsTrue (validRangeList (rSetRanges rs1)) → IsTrue (validRangeList (rSetRanges rs2))
      → IsTrue (validRangeList (filter (λ x → (rangeIsEmpty x == false))
                  (merge2 (rSetRanges rs1) (rSetRanges rs2))))
intersection0 ⦃ o ⦄ ⦃ dio ⦄ rs1 rs2 prf1 prf2 = subst IsTrue (sym (intersectionHolds ⦃ o ⦄ ⦃ dio ⦄ rs1 rs2 prf1 prf2)) IsTrue.itsTrue

-- used for proving that union is valid (merge1 returns a valid range list)
merge1IsSorted0 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (h1 h2 : Range a) → (t1 t2 : RSet a) → (b : Bool)
         → IsTrue (validRangeList (h1 ∷ (rSetRanges t1))) → IsTrue (validRangeList (h2 ∷ (rSetRanges t2)))
         → sortedRangeList (if_then_else_ b (h1 ∷ (merge1 (rSetRanges t1) (h2 ∷ (rSetRanges t2))))
            (h2 ∷ (merge1 (h1 ∷ (rSetRanges t1)) (rSetRanges t2)))) ≡ true
merge1IsSorted1 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs1 : RSet a) → (rs2 : RSet a)
         → IsTrue (validRangeList (rSetRanges rs1)) → IsTrue (validRangeList (rSetRanges rs2))
         → sortedRangeList (merge1 (rSetRanges rs1) (rSetRanges rs2)) ≡ true

merge1Sorted : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
   → (rs1 : RSet a) → (rs2 : RSet a)
   → IsTrue (validRangeList (rSetRanges rs1))
   → IsTrue (validRangeList (rSetRanges rs2))
   → IsTrue (sortedRangeList (merge1 (rSetRanges rs1) (rSetRanges rs2)))

merge1Sorted ⦃ o ⦄ ⦃ dio ⦄ rs1 rs2 prf1 prf2 = subst IsTrue (sym (merge1IsSorted1 rs1 rs2 prf1 prf2)) IsTrue.itsTrue

-- union of two valid ranged sets is also valid range set
unionHolds : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
         → (rs1 : RSet a) → (rs2 : RSet a)
         → (prf1 : IsTrue (validRangeList (rSetRanges rs1)))
         → (prf2 : IsTrue (validRangeList (rSetRanges rs2)))
         → IsTrue (validRangeList (normalise (merge1 (rSetRanges rs1) (rSetRanges rs2))
          ⦃ merge1Sorted rs1 rs2 prf1 prf2 ⦄ ⦃ merge1HasValidRanges rs1 rs2 prf1 prf2 ⦄))
unionHolds ⦃ o ⦄ ⦃ dio ⦄ rs1 rs2 prf1 prf2 = normalisedSortedList
   (merge1 (rSetRanges rs1) (rSetRanges rs2)) (merge1Sorted rs1 rs2 prf1 prf2)
      (merge1HasValidRanges rs1 rs2 prf1 prf2)

-- used for proving negation is valid
{-# TERMINATING #-}
valid : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a)
   → {IsTrue (validRangeList (rSetRanges rs))}
   → (validRangeList (rSetRanges rs)) ≡ (validBoundaryList (bounds1 (rSetRanges rs)))

validSetBounds : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
   → (bs : List (Boundary a)) → validBoundaryList (setBounds1 bs) ≡ validBoundaryList bs

validRanges1 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (bs : List (Boundary a))
   → validRangeList (ranges1 bs) ≡ validBoundaryList bs

-- negation of valid ranged set is also valid
prop3 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a)
   → IsTrue (validRangeList (rSetRanges rs))
   → validRangeList (rSetRanges rs) ≡ validBoundaryList (setBounds1 (bounds1 (rSetRanges rs)))
prop3 ⦃ o ⦄ ⦃ dio ⦄ rs prf = trans (valid rs {prf}) (sym (validSetBounds (bounds1 (rSetRanges rs))))

prop4 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a)
   → IsTrue (validRangeList (rSetRanges rs))
   → validRangeList (rSetRanges rs) ≡ validRangeList (ranges1 (setBounds1 (bounds1 (rSetRanges rs))))

prop4 ⦃ o ⦄ ⦃ dio ⦄ rs prf = trans (prop3 rs prf) (sym (validRanges1 (setBounds1 (bounds1 (rSetRanges rs)))))

negation : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a)
   → (IsTrue (validRangeList (rSetRanges rs)))
   → (IsTrue (validRangeList (ranges1 (setBounds1 (bounds1 (rSetRanges rs))))))
negation ⦃ o ⦄ ⦃ dio ⦄ rs prf = subst IsTrue (prop4 rs prf) prf

-- empty range is valid
emptyRangeValid : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (validRangeList ⦃ o ⦄ ⦃ dio ⦄ []) ≡ true
emptyRangeValid = refl
empty : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → IsTrue (validRangeList ⦃ o ⦄ ⦃ dio ⦄ [])
empty ⦃ o ⦄ ⦃ dio ⦄ = subst IsTrue (sym (emptyRangeValid ⦃ o ⦄ ⦃ dio ⦄)) IsTrue.itsTrue

-- full range is valid
fullRangeValid : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ →
      (validRangeList ⦃ o ⦄ ⦃ dio ⦄ (fullRange ⦃ o ⦄ ⦃ dio ⦄ ∷ [])) ≡ true
full0 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ →
      IsTrue (validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg BoundaryBelowAll BoundaryAboveAll) ∷ []))
full0 ⦃ o ⦄ ⦃ dio ⦄ = subst IsTrue (sym (fullRangeValid ⦃ o ⦄ ⦃ dio ⦄)) IsTrue.itsTrue

-- any singleton range is valid
singletonRangeValid0 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (x : a) → (validRangeList ((singletonRange x) ∷ [])) ≡ true
singletonRangeValid : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (x : a) → IsTrue (validRangeList ((singletonRange x) ∷ []))
singletonRangeValid x = subst IsTrue (sym (singletonRangeValid0 x)) IsTrue.itsTrue

rSingleton : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → a → RSet a
rSingleton ⦃ o ⦄ ⦃ dio ⦄ a = RS ((singletonRange a) ∷ []) {singletonRangeValid a}
{-# COMPILE AGDA2HS rSingleton #-}

normaliseRangeList : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
   → List (Range a) → List (Range a)
normaliseRangeList [] = []
normaliseRangeList rs@(r1 ∷ rss) =
   normalise (sort (filter (λ r → (rangeIsEmpty r) == false) rs))
      ⦃ sortedList rs ⦄ ⦃ validRangesList rs ⦄
{-# COMPILE AGDA2HS normaliseRangeList #-}

makeRangedSet : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
   → List (Range a) → RSet a
makeRangedSet ⦃ o ⦄ ⦃ dio ⦄ [] = RS [] {empty ⦃ o ⦄ ⦃ dio ⦄}
makeRangedSet ⦃ o ⦄ ⦃ dio ⦄ rs@(r1 ∷ rss) = RS (normaliseRangeList rs)
   { normalisedSortedList (sort (filter (λ r → (rangeIsEmpty r) == false) rs)) (sortedList rs) (validRangesList rs) }
{-# COMPILE AGDA2HS makeRangedSet #-}

rangesAreEmpty : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → List (Range a) → Bool
rangesAreEmpty [] = true
rangesAreEmpty (r ∷ rs) = false
{-# COMPILE AGDA2HS rangesAreEmpty #-}

rSetIsEmpty : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a) → Bool
rSetIsEmpty ⦃ o ⦄ ⦃ dio ⦄ rset@(RS ranges) = rangesAreEmpty ⦃ o ⦄ ⦃ dio ⦄ ranges
{-# COMPILE AGDA2HS rSetIsEmpty #-}

rSetNegation : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rg : RSet a) → {(IsTrue (validRangeList (rSetRanges rg)))} → RSet a
rSetNegation ⦃ o ⦄ ⦃ dio ⦄ set@(RS ranges) {prf} =
   RS (ranges1 (setBounds1 (bounds1 ranges))) {negation set prf}

{-# COMPILE AGDA2HS rSetNegation #-}

rSetIsFull : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a)
      → {IsTrue (validRangeList (rSetRanges rs))} → Bool
rSetIsFull set {prf} = rSetIsEmpty (rSetNegation set {prf})
{-# COMPILE AGDA2HS rSetIsFull #-}

rSetEmpty : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → RSet a
rSetEmpty ⦃ o ⦄ ⦃ dio ⦄ = RS [] {empty ⦃ o ⦄ ⦃ dio ⦄}
{-# COMPILE AGDA2HS rSetEmpty #-}

rSetFull : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → RSet a
rSetFull ⦃ o ⦄ ⦃ dio ⦄ = RS ((Rg BoundaryBelowAll BoundaryAboveAll) ∷ []) {full0 ⦃ o ⦄ ⦃ dio ⦄}
{-# COMPILE AGDA2HS rSetFull #-}

rSetHas : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a) → {IsTrue (validRangeList (rSetRanges rs))} → a → Bool
rSetHas (RS []) _ = false
rSetHas ⦃ o ⦄ ⦃ dio ⦄ (RS ls@(r ∷ [])) value = rangeHas ⦃ o ⦄ r value
rSetHas ⦃ o ⦄ ⦃ dio ⦄ rst@(RS ls@(r ∷ rs)) {prf} value = (rangeHas ⦃ o ⦄ r value) || (rSetHas (RS rs {headandtail rst prf}) {headandtail rst prf} value)
{-# COMPILE AGDA2HS rSetHas #-}

_-?-_ : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a) → {IsTrue (validRangeList (rSetRanges rs))} → a → Bool
_-?-_ rs {prf} = rSetHas rs {prf}
{-# COMPILE AGDA2HS _-?-_ #-}

negationHelper : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a)
         → {tr0 : IsTrue (validRangeList (rSetRanges rs))}
         → validRangeList (rSetRanges (rSetNegation rs {tr0})) ≡ validRangeList (ranges1 (setBounds1 (bounds1 (rSetRanges rs))))

negation2 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs : RSet a)
         → {tr0 : IsTrue (validRangeList (rSetRanges rs))}
         → (tr : IsTrue (validRangeList (ranges1 (setBounds1 (bounds1 (rSetRanges rs))))))
         → IsTrue (validRangeList (rSetRanges (rSetNegation rs {tr0})))
negation2 rs {prf0} prf = subst IsTrue (sym (negationHelper rs {prf0})) prf

rSetUnion : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rs1 : RSet a) → {IsTrue (validRangeList (rSetRanges rs1))}
      → (rs2 : RSet a) → {IsTrue (validRangeList (rSetRanges rs2))} → RSet a
rSetUnion ⦃ o ⦄ ⦃ dio ⦄ r1@(RS ls1) {prf1} r2@(RS ls2) {prf2} =
   RS (normalise (merge1 ls1 ls2) ⦃ merge1Sorted r1 r2 prf1 prf2 ⦄
    ⦃ merge1HasValidRanges r1 r2 prf1 prf2 ⦄)
    {unionHolds r1 r2 prf1 prf2}

{-# COMPILE AGDA2HS rSetUnion #-}

_-\/-_ : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rs1 : RSet a) → {IsTrue (validRangeList (rSetRanges rs1))}
      → (rs2 : RSet a) → {IsTrue (validRangeList (rSetRanges rs2))} → RSet a
_-\/-_ rs1 {prf1} rs2 {prf2} = rSetUnion rs1 {prf1} rs2 {prf2}
{-# COMPILE AGDA2HS _-\/-_ #-}

unionHelper : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs1 : RSet a) → (rs2 : RSet a)
         → (prf1 : IsTrue (validRangeList (rSetRanges rs1))) → (prf2 : IsTrue (validRangeList (rSetRanges rs2)))
         → validRangeList (rSetRanges (rSetUnion rs1 {prf1} rs2 {prf2}))
         ≡ validRangeList (normalise (merge1 (rSetRanges rs1) (rSetRanges rs2)) ⦃ merge1Sorted rs1 rs2 prf1 prf2 ⦄ ⦃ merge1HasValidRanges rs1 rs2 prf1 prf2 ⦄)
unionHelper ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ls1) rs2@(RS ls2) prf1 prf2 =
  begin
     validRangeList (rSetRanges (rSetUnion rs1 {prf1} rs2 {prf2}))
  =⟨⟩
     validRangeList (rSetRanges (RS (normalise (merge1 (rSetRanges rs1) (rSetRanges rs2)) ⦃ merge1Sorted rs1 rs2 prf1 prf2 ⦄  ⦃ merge1HasValidRanges rs1 rs2 prf1 prf2 ⦄) {unionHolds rs1 rs2 prf1 prf2}))
  =⟨⟩
     validRangeList (normalise (merge1 (rSetRanges rs1) (rSetRanges rs2)) ⦃ merge1Sorted rs1 rs2 prf1 prf2 ⦄  ⦃ merge1HasValidRanges rs1 rs2 prf1 prf2 ⦄)
  end

union2 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs1 : RSet a) → (rs2 : RSet a)
         → (prf1 : IsTrue (validRangeList (rSetRanges rs1))) → (prf2 : IsTrue (validRangeList (rSetRanges rs2)))
         → IsTrue (validRangeList (normalise (merge1 (rSetRanges rs1) (rSetRanges rs2)) ⦃ merge1Sorted rs1 rs2 prf1 prf2 ⦄  ⦃ merge1HasValidRanges rs1 rs2 prf1 prf2 ⦄))
         → IsTrue (validRangeList (rSetRanges (rSetUnion rs1 {prf1} rs2 {prf2})))
union2 rs1 rs2 prf1 prf2 prf = subst IsTrue (sym (unionHelper rs1 rs2 prf1 prf2)) prf

rSetIntersection : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rs1 : RSet a) → {IsTrue (validRangeList (rSetRanges rs1))}
      → (rs2 : RSet a) → {IsTrue (validRangeList (rSetRanges rs2))} → RSet a
rSetIntersection ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ls1) {prf1} rs2@(RS ls2) {prf2} =
    RS ⦃ o ⦄ ⦃ dio ⦄
      (filter (λ x → rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false) (merge2 ⦃ o ⦄ ⦃ dio ⦄ ls1 ls2))
         {intersection0 rs1 rs2 prf1 prf2}
{-# COMPILE AGDA2HS rSetIntersection #-}

_-/\-_ : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rs1 : RSet a) → {IsTrue (validRangeList (rSetRanges rs1))}
      → (rs2 : RSet a) → {IsTrue (validRangeList (rSetRanges rs2))} → RSet a
_-/\-_ rs1 {prf1} rs2 {prf2} = rSetIntersection rs1 {prf1} rs2 {prf2}
{-# COMPILE AGDA2HS _-/\-_ #-}

intersectHelper : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs1 : RSet a) → (rs2 : RSet a)
         → (prf1 : IsTrue (validRangeList (rSetRanges rs1))) → (prf2 : IsTrue (validRangeList (rSetRanges rs2)))
         → validRangeList (rSetRanges (rSetIntersection rs1 {prf1} rs2 {prf2})) ≡ validRangeList (filter (λ r → (rangeIsEmpty r) == false) (merge2 (rSetRanges rs1) (rSetRanges rs2)))

intersection22 : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (rs1 : RSet a) → (rs2 : RSet a)
         → (prf1 : IsTrue (validRangeList (rSetRanges rs1))) → (prf2 : IsTrue (validRangeList (rSetRanges rs2)))
         → IsTrue (validRangeList (filter (λ r → (rangeIsEmpty r) == false) (merge2 (rSetRanges rs1) (rSetRanges rs2))))
         → IsTrue (validRangeList (rSetRanges (rSetIntersection rs1 {prf1} rs2 {prf2})))
intersection22 ⦃ o ⦄ ⦃ dio ⦄ rs1 rs2 prf1 prf2 prf = subst IsTrue (sym (intersectHelper rs1 rs2 prf1 prf2)) prf

rSetDifference : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rs1 : RSet a) → {IsTrue (validRangeList (rSetRanges rs1))}
      → (rs2 : RSet a) → {IsTrue (validRangeList (rSetRanges rs2))} → RSet a
rSetDifference ⦃ o ⦄ ⦃ dio ⦄ rs1 {prf1} rs2 {prf2} =
   rSetIntersection rs1 {prf1} (rSetNegation rs2 {prf2}) {negation2 rs2 (negation rs2 prf2)}
{-# COMPILE AGDA2HS rSetDifference #-}

_-!-_ : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rs1 : RSet a) → {IsTrue (validRangeList (rSetRanges rs1))}
      → (rs2 : RSet a) → {IsTrue (validRangeList (rSetRanges rs2))} → RSet a
_-!-_ rs1 {prf1} rs2 {prf2} = rSetDifference rs1 {prf1} rs2 {prf2}
{-# COMPILE AGDA2HS _-!-_ #-}

rSetIsSubset : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rs1 : RSet a) → {IsTrue (validRangeList (rSetRanges rs1))}
      → (rs2 : RSet a) → {IsTrue (validRangeList (rSetRanges rs2))} → Bool
rSetIsSubset rs1 {prf1} rs2 {prf2} = rSetIsEmpty (rSetDifference rs1 {prf1} rs2 {prf2})
{-# COMPILE AGDA2HS rSetIsSubset #-}

_-<=-_ : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rs1 : RSet a) → {IsTrue (validRangeList (rSetRanges rs1))}
      → (rs2 : RSet a) → {IsTrue (validRangeList (rSetRanges rs2))} → Bool
_-<=-_ rs1 {prf1} rs2 {prf2}  = rSetIsSubset rs1 {prf1} rs2 {prf2}
{-# COMPILE AGDA2HS _-<=-_ #-}

rSetIsSubsetStrict : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rs1 : RSet a) → {IsTrue (validRangeList (rSetRanges rs1))}
      → (rs2 : RSet a) → {IsTrue (validRangeList (rSetRanges rs2))} → Bool
rSetIsSubsetStrict rs1 {prf1} rs2 {prf2} = rSetIsEmpty
   (rSetDifference rs1 {prf1} rs2 {prf2}) && not (rSetIsEmpty (rSetDifference rs2 {prf2} rs1 {prf1}))
{-# COMPILE AGDA2HS rSetIsSubsetStrict #-}

_-<-_ : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄
      → (rs1 : RSet a) → {IsTrue (validRangeList (rSetRanges rs1))}
      → (rs2 : RSet a) → {IsTrue (validRangeList (rSetRanges rs2))} → Bool
_-<-_ rs1 {prf1} rs2 {prf2} = rSetIsSubsetStrict rs1 {prf1} rs2 {prf2}
{-# COMPILE AGDA2HS _-<-_ #-}

instance
    isRangedSetSemigroup : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Semigroup (RSet a)
    isRangedSetSemigroup ._<>_ r1@(RS l1 {prf1}) r2@(RS l2 {prf2}) = rSetUnion r1 {prf1} r2 {prf2}

    isRangedSetMonoid : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Monoid (RSet a)
    isRangedSetMonoid .mempty = rSetEmpty

rSetUnfold : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → (b : Boundary a)
            → (f : Boundary a → Boundary a)
            → (g : Boundary a → Maybe (Boundary a))
            → ⦃ IsTrue (validFunction2 b f) ⦄
            → ⦃ IsTrue (validFunction b g) ⦄ → RSet a

rSetUnfold ⦃ o ⦄ ⦃ dio ⦄ bound upperFunc succFunc ⦃ fValid ⦄ ⦃ gValid ⦄ =
   RS (normalise (ranges2 bound upperFunc succFunc)
               ⦃ unfoldSorted bound upperFunc succFunc ⦄ ⦃ ranges2HasValidRanges bound upperFunc succFunc fValid gValid ⦄)
      { normalisedSortedList (ranges2 bound upperFunc succFunc)
               (unfoldSorted bound upperFunc succFunc) (ranges2HasValidRanges bound upperFunc succFunc fValid gValid) }

{-# COMPILE AGDA2HS rSetUnfold #-}

okAdjIsTrue ⦃ o ⦄ ⦃ dio ⦄ r@(Rg l1 u1) r2@(Rg l2 u2) = refl

headandtailSorted rs@(r ∷ []) prf = IsTrue.itsTrue
headandtailSorted rs@(r ∷ rss@(r2 ∷ rsss)) prf = isTrue&&₂ {r <= r2} prf

headandtail rs@(RS (r ∷ [])) prf = IsTrue.itsTrue
headandtail rs@(RS (r ∷ rss@(r2 ∷ rsss))) prf = isTrue&&₂ {okAdjacent r r2} prf

tailandhead rs@(RS (r ∷ [])) prf = prf
tailandhead rs@(RS (r ∷ rss@(r2 ∷ rsss))) prf = isTrue&&₁ {rangeLower r <= rangeUpper r}
      (subst IsTrue (okAdjIsTrue r r2) (isTrue&&₁ {okAdjacent r r2} prf))

okAdjValid rs@(r2 ∷ rss) r prf = isTrue&&₁ {okAdjacent r r2} prf

tailandhead2 rs@(r ∷ []) prf = prf
tailandhead2 rs@(r ∷ rss@(r2 ∷ rsss)) prf = isTrue&&₁ {rangeLower r <= rangeUpper r}
      (subst IsTrue (okAdjIsTrue r r2) (isTrue&&₁ {okAdjacent r r2} prf))

headandtail2 rs@(r ∷ []) prf = IsTrue.itsTrue
headandtail2 rs@(r ∷ rss@(r2 ∷ rsss)) prf = isTrue&&₂ {okAdjacent r r2} prf

headandtailValidRanges rs@(r ∷ []) prf = IsTrue.itsTrue
headandtailValidRanges rs@(r ∷ rss@(r2 ∷ rsss)) prf = isTrue&&₂ {rangeLower r <= rangeUpper r} prf

ranges2HasValidRanges ⦃ o ⦄ ⦃ dio ⦄ b f g prf1 prf2 = subst IsTrue (sym (ranges2HasValidRanges0 b f g prf1 prf2)) IsTrue.itsTrue

ranges2HasValidRanges000 ⦃ o ⦄ ⦃ dio ⦄ b b1 f g false prf1 prf2 =
   begin
      (validRanges ⦃ o ⦄ ⦃ dio ⦄ ((Rg b (f b)) ∷ []))
  =⟨⟩
      b <= (f b) && (validRanges ⦃ o ⦄ ⦃ dio ⦄ [])
  =⟨⟩
      b <= (f b) && true
  =⟨ prop_and_true (b <= (f b)) ⟩
      b <= (f b)
  =⟨ propIsTrue (b <= (f b)) (rangesLTEQ b f prf1) ⟩
     true
   end
ranges2HasValidRanges000 ⦃ o ⦄ ⦃ dio ⦄ b b1 f g true prf1 prf2 =
   begin
      (validRanges ((Rg b (f b)) ∷ (ranges2 b1 f g)))
  =⟨⟩
      b <= (f b) && (validRanges (ranges2 b1 f g))
  =⟨ cong (b <= (f b) &&_) (ranges2HasValidRanges0 b1 f g (stupid1 b b1 f g prf1 prf2 true IsTrue.itsTrue)
         (stupid2 b b1 f g prf1 prf2 true IsTrue.itsTrue) ) ⟩
      b <= (f b) && true
  =⟨ prop_and_true (b <= (f b)) ⟩
      b <= (f b)
  =⟨ propIsTrue (b <= (f b)) (rangesLTEQ b f prf1) ⟩
     true
   end

ranges2HasValidRanges00 ⦃ o ⦄ ⦃ dio ⦄ b f g Nothing prf1 prf2 =
   begin
      (validRanges ⦃ o ⦄ ⦃ dio ⦄ ((Rg b (f b)) ∷ (ranges3 Nothing f g)))
  =⟨⟩
      validRanges ⦃ o ⦄ ⦃ dio ⦄ ((Rg b (f b)) ∷ [])
  =⟨⟩
      (b <= (f b)) && (validRanges ⦃ o ⦄ ⦃ dio ⦄ [])
  =⟨⟩
      (b <= (f b)) && true
  =⟨ prop_and_true (b <= (f b)) ⟩
      b <= (f b)
  =⟨ propIsTrue (b <= (f b)) (rangesLTEQ b f prf1) ⟩
     true
   end
ranges2HasValidRanges00 ⦃ o ⦄ ⦃ dio ⦄ b f g (Just b1) prf1 prf2 =
   begin
      (validRanges ((Rg b (f b)) ∷ (ranges3 (Just b1) f g)))
  =⟨⟩
      validRanges ((Rg b (f b)) ∷ (if ((validFunction2 b1 f) && (validFunction b1 g)) then (ranges2 b1 f g) else []))
  =⟨ ranges2HasValidRanges000 b b1 f g ((validFunction2 b1 f) && (validFunction b1 g)) prf1 prf2 ⟩
     true
   end

ranges2HasValidRanges0 ⦃ o ⦄ ⦃ dio ⦄ b f g prf1 prf2 =
   begin
      (validRanges (ranges2 b f g))
  =⟨⟩
      validRanges ((Rg b (f b)) ∷ (ranges3 (g b) f g))
  =⟨ ranges2HasValidRanges00 b f g (g b) prf1 prf2 ⟩
      true
   end

merge1HasValidRanges ⦃ o ⦄ ⦃ dio ⦄ rs1 rs2 prf1 prf2 = subst IsTrue (sym (merge1HasValidRanges0 rs1 rs2 prf1 prf2)) IsTrue.itsTrue

validListMeansValidRanges ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS []) prf =
   begin
      (validRanges ⦃ o ⦄ ⦃ dio ⦄ [])
  =⟨⟩
  true
 end
validListMeansValidRanges ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS (r1 ∷ [])) prf =
   begin
      (validRanges (r1 ∷ []))
  =⟨⟩
      (rangeLower r1 <= rangeUpper r1) && (validRanges ⦃ o ⦄ ⦃ dio ⦄ [])
  =⟨⟩
      (rangeLower r1 <= rangeUpper r1) && true
  =⟨ prop_and_true (rangeLower r1 <= rangeUpper r1) ⟩
   (rangeLower r1 <= rangeUpper r1)
  =⟨ propIsTrue (rangeLower r1 <= rangeUpper r1) prf ⟩
  true
 end
validListMeansValidRanges ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ranges@(r1 ∷ r2 ∷ r3)) prf =
   begin
      (validRanges ranges)
  =⟨⟩
      (rangeLower r1 <= rangeUpper r1) && (validRanges ⦃ o ⦄ ⦃ dio ⦄ (r2 ∷ r3))
  =⟨ cong ((rangeLower r1 <= rangeUpper r1) &&_) (validListMeansValidRanges (RS (r2 ∷ r3) {headandtail rs1 prf}) (headandtail rs1 prf)) ⟩
      (rangeLower r1 <= rangeUpper r1) && true
  =⟨ prop_and_true (rangeLower r1 <= rangeUpper r1) ⟩
   (rangeLower r1 <= rangeUpper r1)
  =⟨ propIsTrue (rangeLower r1 <= rangeUpper r1) (tailandhead rs1 prf) ⟩
  true
 end

merge1HasValidRanges00 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS t1) rs2@(RS t2) h1 h2 prf1 prf2 true =
   begin
      validRanges (h1 ∷ (merge1 (rSetRanges rs1) (h2 ∷ (rSetRanges rs2))))
  =⟨⟩
      (rangeLower h1 <= rangeUpper h1) && (validRanges (merge1 t1 (h2 ∷ t2)))
  =⟨ cong ((rangeLower h1 <= rangeUpper h1) &&_)
   (merge1HasValidRanges0 rs1 (RS (h2 ∷ t2) {prf2}) (headandtail (RS (h1 ∷ t1) {prf1}) prf1) prf2) ⟩
   (rangeLower h1 <= rangeUpper h1) && true
  =⟨ prop_and_true (rangeLower h1 <= rangeUpper h1) ⟩
   (rangeLower h1 <= rangeUpper h1)
  =⟨ propIsTrue (rangeLower h1 <= rangeUpper h1) (tailandhead (RS (h1 ∷ t1) {prf1}) prf1) ⟩
   true
 end
merge1HasValidRanges00 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS t1) rs2@(RS t2) h1 h2 prf1 prf2 false =
   begin
      validRanges (h2 ∷ (merge1 (h1 ∷ t1) t2))
  =⟨⟩
      (rangeLower h2 <= rangeUpper h2) && (validRanges (merge1 (h1 ∷ t1) t2))
  =⟨ cong ((rangeLower h2 <= rangeUpper h2) &&_)
   (merge1HasValidRanges0 (RS (h1 ∷ t1) {prf1}) rs2 prf1 (headandtail (RS (h2 ∷ t2) {prf2}) prf2)) ⟩
   (rangeLower h2 <= rangeUpper h2) && true
  =⟨ prop_and_true (rangeLower h2 <= rangeUpper h2) ⟩
   (rangeLower h2 <= rangeUpper h2)
  =⟨ propIsTrue (rangeLower h2 <= rangeUpper h2) (tailandhead (RS (h2 ∷ t2) {prf2}) prf2) ⟩
   true
 end

merge1HasValidRanges0 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS []) rs2@(RS []) prf1 prf2 =
   begin
      (validRanges (merge1 (rSetRanges rs1) (rSetRanges rs2)))
  =⟨⟩
      validRanges ⦃ o ⦄ ⦃ dio ⦄ []
  =⟨⟩
  true
 end
merge1HasValidRanges0 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS (h1 ∷ t1)) rs2@(RS []) prf1 prf2 =
   begin
      (validRanges (merge1 (rSetRanges rs1) (rSetRanges rs2)))
  =⟨⟩
      validRanges (h1 ∷ t1)
  =⟨ validListMeansValidRanges rs1 prf1 ⟩
  true
 end
merge1HasValidRanges0 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS []) rs2@(RS (h2 ∷ t2)) prf1 prf2 =
   begin
      (validRanges (merge1 (rSetRanges rs1) (rSetRanges rs2)))
  =⟨⟩
      validRanges (h2 ∷ t2)
  =⟨ validListMeansValidRanges rs2 prf2 ⟩
  true
 end
merge1HasValidRanges0 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS (h1 ∷ t1)) rs2@(RS (h2 ∷ t2)) prf1 prf2 =
   begin
      (validRanges (merge1 (rSetRanges rs1) (rSetRanges rs2)))
  =⟨⟩
      validRanges (if_then_else_ (h1 < h2) (h1 ∷ (merge1 t1 (h2 ∷ t2))) (h2 ∷ (merge1 (h1 ∷ t1) (t2))))
  =⟨ merge1HasValidRanges00 (RS t1 {headandtail rs1 prf1}) (RS t2 {headandtail rs2 prf2}) h1 h2 prf1 prf2 (h1 < h2) ⟩
  true
 end

normalisedSortedList ⦃ o ⦄ ⦃ dio ⦄ ms prf prf2 = subst IsTrue (sym (normalisedSortedList0 ms prf prf2)) IsTrue.itsTrue

normalisedSortedList00 ⦃ o ⦄ ⦃ dio ⦄ rs r1 r2 prf prf2 true =
   begin
      validRangeList (if_then_else_ true
      (normalise ((Rg (rangeLower r1) (max (rangeUpper r1) (rangeUpper r2))) ∷ rs) ⦃ sortedListComposed r1 r2 rs prf ⦄ ⦃ validRangesComposed r1 r2 rs prf prf2 ⦄)
         (r1 ∷ (normalise (r2 ∷ rs) ⦃ headandtailSorted (r1 ∷ r2 ∷ rs) prf ⦄ ⦃ headandtailValidRanges (r1 ∷ r2 ∷ rs) prf2 ⦄)))
  =⟨⟩
      validRangeList ((normalise ((Rg (rangeLower r1) (max (rangeUpper r1) (rangeUpper r2))) ∷ rs) ⦃ sortedListComposed r1 r2 rs prf ⦄ ⦃ validRangesComposed r1 r2 rs prf prf2 ⦄) )
  =⟨ normalisedSortedList0 ((Rg (rangeLower r1) (max (rangeUpper r1) (rangeUpper r2))) ∷ rs) (sortedListComposed r1 r2 rs prf) (validRangesComposed r1 r2 rs prf prf2) ⟩
  true
 end
normalisedSortedList00 ⦃ o ⦄ ⦃ dio ⦄ rs r1 r2 prf prf2 false =
   begin
      validRangeList (if_then_else_ false
      (normalise ((Rg (rangeLower r1) (max (rangeUpper r1) (rangeUpper r2))) ∷ rs) ⦃ sortedListComposed r1 r2 rs prf ⦄ ⦃ validRangesComposed r1 r2 rs prf prf2 ⦄)
         (r1 ∷ (normalise (r2 ∷ rs) ⦃ headandtailSorted (r1 ∷ r2 ∷ rs) prf ⦄ ⦃ headandtailValidRanges (r1 ∷ r2 ∷ rs) prf2 ⦄)))
  =⟨⟩
      validRangeList (r1 ∷ (normalise (r2 ∷ rs) ⦃ headandtailSorted (r1 ∷ r2 ∷ rs) prf ⦄ ⦃ headandtailValidRanges (r1 ∷ r2 ∷ rs) prf2 ⦄))
  =⟨ validList r1 (normalise (r2 ∷ rs) ⦃ headandtailSorted (r1 ∷ r2 ∷ rs) prf ⦄ ⦃ headandtailValidRanges (r1 ∷ r2 ∷ rs) prf2 ⦄)
  (normalisedSortedList (r2 ∷ rs) (headandtailSorted (r1 ∷ r2 ∷ rs) prf) (headandtailValidRanges (r1 ∷ r2 ∷ rs) prf2))  ⟩
  true
 end

normalisedSortedList0 ⦃ o ⦄ ⦃ dio ⦄ ms@([]) prf prf2 =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (normalise [] ⦃ prf ⦄ ⦃ prf2 ⦄)
  =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ []
  =⟨⟩
      true
   end
normalisedSortedList0 ⦃ o ⦄ ⦃ dio ⦄ ms@(m ∷ []) prf prf2 =
   begin
      validRangeList (normalise ms ⦃ prf ⦄ ⦃ prf2 ⦄)
  =⟨⟩
      validRangeList (m ∷ [])
  =⟨⟩
      (rangeLower m <= rangeUpper m)
  =⟨ sym (prop_and_true (rangeLower m <= rangeUpper m))  ⟩
      (rangeLower m <= rangeUpper m) && true
  =⟨⟩
      (rangeLower m <= rangeUpper m) && (validRanges ⦃ o ⦄ ⦃ dio ⦄ [])
  =⟨⟩
      validRanges ms
  =⟨ propIsTrue (validRanges ms) prf2 ⟩
      true
  end
normalisedSortedList0 ⦃ o ⦄ ⦃ dio ⦄ ms@(r1 ∷ r2 ∷ rs) prf prf2 =
   begin
      validRangeList (normalise ms ⦃ prf ⦄ ⦃ prf2 ⦄)
  =⟨⟩
      validRangeList (if_then_else_ (overlap1 r1 r2)
      (normalise ((Rg (rangeLower r1) (max (rangeUpper r1) (rangeUpper r2))) ∷ rs) ⦃ sortedListComposed r1 r2 rs prf ⦄ ⦃ validRangesComposed r1 r2 rs prf prf2 ⦄)
         (r1 ∷ (normalise (r2 ∷ rs) ⦃ headandtailSorted (r1 ∷ r2 ∷ rs) prf ⦄ ⦃ headandtailValidRanges (r1 ∷ r2 ∷ rs) prf2 ⦄)))
  =⟨ normalisedSortedList00 rs r1 r2 prf prf2 (overlap1 r1 r2) ⟩
      true
  end

unfoldIsSorted00 ⦃ o ⦄ ⦃ dio ⦄ b f g b1 false =
     begin
      sortedRangeList ((Rg b (f b)) ∷ (if_then_else_ false (ranges2 b1 f g) []))
  =⟨⟩
      sortedRangeList ((Rg b (f b)) ∷ [])
  =⟨⟩
   true
   end
unfoldIsSorted00 ⦃ o ⦄ ⦃ dio ⦄ b f g b1 true =
     begin
      sortedRangeList ((Rg b (f b)) ∷ (if_then_else_ true (ranges2 b1 f g) []))
  =⟨⟩
      sortedRangeList ((Rg b (f b)) ∷ (ranges2 b1 f g))
  =⟨ validSortedList (Rg b (f b)) (ranges2 b1 f g) (unfoldSorted b1 f g) ⟩
   true
   end

unfoldIsSorted0 ⦃ o ⦄ ⦃ dio ⦄ b f g Nothing =
     begin
      sortedRangeList ((Rg b (f b)) ∷ (ranges3 Nothing f g))
  =⟨⟩
      sortedRangeList ((Rg b (f b)) ∷ [])
  =⟨⟩
   true
   end
unfoldIsSorted0 ⦃ o ⦄ ⦃ dio ⦄ b f g mb@(Just b1) =
     begin
      sortedRangeList ((Rg b (f b)) ∷ (ranges3 mb f g))
  =⟨⟩
      sortedRangeList ((Rg b (f b)) ∷ (if_then_else_ ((validFunction2 b1 f) && (validFunction b1 g)) (ranges2 b1 f g) []))
  =⟨ unfoldIsSorted00 b f g b1 ((validFunction2 b1 f) && (validFunction b1 g)) ⟩
   true
   end

unfoldIsSorted ⦃ o ⦄ ⦃ dio ⦄ b f g =
   begin
      sortedRangeList (ranges2 b f g)
  =⟨⟩
      sortedRangeList ((Rg b (f b)) ∷ (ranges3 (g b) f g))
  =⟨ unfoldIsSorted0 b f g (g b) ⟩
   true
   end

unfoldSorted ⦃ o ⦄ ⦃ dio ⦄ b f g = subst IsTrue (sym (unfoldIsSorted b f g)) IsTrue.itsTrue

merge1IsSorted0 ⦃ o ⦄ ⦃ dio ⦄ h1 h2 rs1@(RS []) rs2@(RS []) true prf1 prf2 =
   begin
      sortedRangeList (h1 ∷ (merge1 [] (h2 ∷ [])))
  =⟨⟩
      sortedRangeList (h1 ∷ h2 ∷ [])
  =⟨ okSorted h1 h2 ⟩
      true
   end
merge1IsSorted0 ⦃ o ⦄ ⦃ dio ⦄ h1 h2 rs1@(RS []) rs2@(RS t2@(h4 ∷ tt2)) true prf1 prf2 =
   begin
      sortedRangeList (h1 ∷ (merge1 [] (h2 ∷ t2)))
  =⟨⟩
      sortedRangeList (h1 ∷ (h2 ∷ t2))
  =⟨ validSortedList h1 (h2 ∷ t2) (validIsSorted (h2 ∷ t2) prf2) ⟩
      true
   end
merge1IsSorted0 ⦃ o ⦄ ⦃ dio ⦄ h1 h2 rs1@(RS t1@(h3 ∷ tt1)) rs2@(RS t2) true prf1 prf2 =
   begin
      sortedRangeList (h1 ∷ (merge1 t1 (h2 ∷ t2)))
  =⟨ validSortedList h1 (merge1 t1 (h2 ∷ t2)) (merge1Sorted rs1 (RS (h2 ∷ t2) {prf2}) (headandtail (RS (h1 ∷ t1) {prf1}) prf1) prf2) ⟩
      true
   end
merge1IsSorted0 ⦃ o ⦄ ⦃ dio ⦄ h1 h2 rs1@(RS []) rs2@(RS []) false prf1 prf2 =
   begin
      sortedRangeList (h2 ∷ (merge1 (h1 ∷ []) []))
  =⟨⟩
      sortedRangeList (h2 ∷ h1 ∷ [])
  =⟨ okSorted h2 h1 ⟩
      true
   end
merge1IsSorted0 ⦃ o ⦄ ⦃ dio ⦄ h1 h2 rs1@(RS t1@(h3 ∷ tt1)) rs2@(RS []) false prf1 prf2 =
   begin
      sortedRangeList (h2 ∷ (merge1 (h1 ∷ t1) []))
  =⟨⟩
      sortedRangeList (h2 ∷ h1 ∷ t1)
  =⟨ validSortedList h2 (h1 ∷ t1) (validIsSorted (h1 ∷ t1) prf1) ⟩
      true
   end
merge1IsSorted0 ⦃ o ⦄ ⦃ dio ⦄ h1 h2 rs1@(RS t1) rs2@(RS t2@(h4 ∷ tt2)) false prf1 prf2 =
   begin
      sortedRangeList (h2 ∷ (merge1 (h1 ∷ t1) t2))
  =⟨ validSortedList h2 (merge1 (h1 ∷ t1) t2) (merge1Sorted (RS (h1 ∷ t1) {prf1}) rs2 prf1 (headandtail (RS (h2 ∷ t2) {prf2}) prf2)) ⟩
      true
   end

merge1IsSorted1 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS []) rs2@(RS []) prf1 prf2 = refl
merge1IsSorted1 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ms1@(h1 ∷ t1)) rs2@(RS []) prf1 prf2 = propIsTrue (sortedRangeList (merge1 (rSetRanges rs1) (rSetRanges rs2))) (validIsSorted (merge1 (rSetRanges rs1) (rSetRanges rs2)) prf1)
merge1IsSorted1 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS []) rs2@(RS ms1@(h1 ∷ t1)) prf1 prf2 = propIsTrue (sortedRangeList (merge1 (rSetRanges rs1) (rSetRanges rs2))) (validIsSorted (merge1 (rSetRanges rs1) (rSetRanges rs2)) prf2)
merge1IsSorted1 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ms1@(h1 ∷ t1)) rs2@(RS ms2@(h2 ∷ t2)) prf1 prf2 =
   begin
      sortedRangeList (merge1 (rSetRanges rs1) (rSetRanges rs2))
  =⟨⟩
      sortedRangeList (if_then_else_ (h1 < h2) (h1 ∷ (merge1 t1 ms2)) (h2 ∷ (merge1 ms1 t2)))
  =⟨ merge1IsSorted0 h1 h2 (RS t1 {headandtail rs1 prf1}) (RS t2 {headandtail rs2 prf2}) (h1 < h2) prf1 prf2 ⟩
      true
   end

singletonRangeValid0 ⦃ o ⦄ ⦃ dio ⦄ x =
  begin
   validRangeList ((singletonRange x) ∷ [])
  =⟨⟩
    ((rangeLower (singletonRange x)) <= (rangeUpper (singletonRange x)))
  =⟨⟩
    ((rangeLower (Rg (BoundaryBelow x) (BoundaryAbove x))) <= (rangeUpper (Rg (BoundaryBelow x) (BoundaryAbove x))))
  =⟨⟩
    (BoundaryBelow x <= BoundaryAbove x)
  =⟨⟩
    ((compare (BoundaryBelow x) (BoundaryAbove x) == LT) || (compare (BoundaryBelow x) (BoundaryAbove x) == EQ))
  =⟨⟩
    (((if_then_else_ (x > x) (if_then_else_ (adjacent x x) EQ GT) LT) == LT) || (compare (BoundaryBelow x) (BoundaryAbove x) == EQ))
  =⟨ cong (_|| (compare (BoundaryBelow x) (BoundaryAbove x) == EQ)) (cong (_== LT) (propIf3 (x > x) (lt x x refl))) ⟩
    ((LT == LT) || (compare (BoundaryBelow x) (BoundaryAbove x) == EQ))
  =⟨⟩
    (true || (compare (BoundaryBelow x) (BoundaryAbove x) == EQ))
  =⟨⟩
    true
  end

intersectHelper ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ls1) rs2@(RS ls2) prf1 prf2 =
  begin
     validRangeList (rSetRanges (rSetIntersection rs1 {prf1} rs2 {prf2}))
  =⟨⟩
     validRangeList (rSetRanges (RS (filter (λ r → (rangeIsEmpty r) == false) (merge2 (rSetRanges rs1) (rSetRanges rs2))) {intersection0 rs1 rs2 prf1 prf2}))
  =⟨⟩
     validRangeList (filter (λ r → (rangeIsEmpty r) == false) (merge2 (rSetRanges rs1) (rSetRanges rs2)))
  end

negationHelper ⦃ o ⦄ ⦃ dio ⦄ rs@(RS ranges) {prf} =
  begin
     validRangeList (rSetRanges (rSetNegation rs {prf}))
  =⟨⟩
     validRangeList (rSetRanges (RS ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ (setBounds1 ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ ranges))) {negation rs prf}))
  =⟨⟩
    validRangeList (ranges1 ⦃ o ⦄ ⦃ dio ⦄ (setBounds1 ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ ranges)))
  =⟨⟩
    validRangeList (ranges1 ⦃ o ⦄ ⦃ dio ⦄ (setBounds1 ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ (rSetRanges rs))))
  end

fullRangeValid ⦃ o ⦄ ⦃ dio ⦄ =
  begin
     validRangeList ⦃ o ⦄ ⦃ dio ⦄ (fullRange ⦃ o ⦄ ⦃ dio ⦄ ∷ [])
  =⟨⟩
    ((rangeLower (fullRange ⦃ o ⦄ ⦃ dio ⦄)) <= (rangeUpper (fullRange ⦃ o ⦄ ⦃ dio ⦄)))
  =⟨⟩
    true
  end

intersection3 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ranges1@(r1 ∷ rss1)) rs2@(RS ranges2@(r2 ∷ rss2)) ⦃ ne1 ⦄ ⦃ ne2 ⦄ prf1 prf2 true =
  begin
    validRangeList (filter (λ x → (rangeIsEmpty x == false))
         (if_then_else_ true
            (merge2 rss1 ranges2) (merge2 ⦃ o ⦄ ⦃ dio ⦄ ranges1 rss2)))
   =⟨⟩
    validRangeList (filter (λ x → (rangeIsEmpty x == false)) (merge2 rss1 ranges2))
   =⟨ intersectionHolds
 ⦃ o ⦄ ⦃ dio ⦄ (RS rss1 {headandtail rs1 ⦃ NonEmpty.itsNonEmpty ⦄ prf1}) rs2 (headandtail ⦃ o ⦄ ⦃ dio ⦄ rs1 ⦃ ne1 ⦄ prf1) prf2 ⟩
      true
   end
intersection3 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ranges1@(r1 ∷ rss1)) rs2@(RS ranges2@(r2 ∷ rss2)) ⦃ ne1 ⦄ ⦃ ne2 ⦄ prf1 prf2 false =
  begin
    validRangeList (filter (λ x → (rangeIsEmpty x == false))
         (if_then_else_ false
            (merge2 ⦃ o ⦄ ⦃ dio ⦄ rss1 ranges2) (merge2 ranges1 rss2)))
   =⟨⟩
    validRangeList (filter (λ x → (rangeIsEmpty x == false)) (merge2 ranges1 rss2))
   =⟨ intersectionHolds
 ⦃ o ⦄ ⦃ dio ⦄ rs1 (RS rss2 {headandtail rs2 ⦃ NonEmpty.itsNonEmpty ⦄ prf2}) prf1 (headandtail ⦃ o ⦄ ⦃ dio ⦄ rs2 ⦃ ne2 ⦄ prf2) ⟩
      true
   end

intersection2 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ranges1@(r1 ∷ rss1)) rs2@(RS ranges2@(r2 ∷ rss2)) ⦃ ne1 ⦄ ⦃ ne2 ⦄ prf1 prf2 false =
  begin
        validRangeList (
       if_then_else_ false

      ((rangeIntersection ⦃ o ⦄ ⦃ dio ⦄ r1 r2) ∷ (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false))
       (if_then_else_ ((rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1) < (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2))
       (merge2 ⦃ o ⦄ ⦃ dio ⦄ rss1 ranges2) (merge2 ⦃ o ⦄ ⦃ dio ⦄ ranges1 rss2))))

       (filter (λ x → (rangeIsEmpty x == false))
         (if_then_else_ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2)
         (merge2 rss1 ranges2) (merge2 ranges1 rss2)))
      )
   =⟨⟩
    validRangeList (filter (λ x → (rangeIsEmpty x == false))
    (if_then_else_ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2)
    (merge2 rss1 ranges2) (merge2 ranges1 rss2)))
   =⟨ intersection3 ⦃ o ⦄ ⦃ dio ⦄ rs1 rs2 ⦃ ne1 ⦄ ⦃ ne2 ⦄ prf1 prf2 (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2) ⟩
    true
   end
intersection2 ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ranges1@(r1 ∷ rss1)) rs2@(RS ranges2@(r2 ∷ rss2)) ⦃ ne1 ⦄ ⦃ ne2 ⦄ prf1 prf2 true =
  begin
        validRangeList (
       if_then_else_ true

      ((rangeIntersection ⦃ o ⦄ ⦃ dio ⦄ r1 r2) ∷ (filter (λ x → (rangeIsEmpty x == false))
       (if_then_else_ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2)
       (merge2 rss1 ranges2) (merge2 ranges1 rss2))))

       (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false))
         (if_then_else_ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2)
         (merge2 ⦃ o ⦄ ⦃ dio ⦄ rss1 ranges2) (merge2 ⦃ o ⦄ ⦃ dio ⦄ ranges1 rss2)))
      )
   =⟨⟩
    validRangeList ((rangeIntersection ⦃ o ⦄ ⦃ dio ⦄ r1 r2) ∷ (filter (λ x → (rangeIsEmpty x == false))
       (if_then_else_ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2)
       (merge2 rss1 ranges2) (merge2 ranges1 rss2))))
   =⟨ validList (rangeIntersection ⦃ o ⦄ ⦃ dio ⦄ r1 r2) (filter (λ x → (rangeIsEmpty x == false))
       (if_then_else_ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2)
       (merge2 rss1 ranges2) (merge2 ranges1 rss2)))
       (subst IsTrue (sym
       (intersection3 ⦃ o ⦄ ⦃ dio ⦄ rs1 rs2 ⦃ ne1 ⦄ ⦃ ne2 ⦄ prf1 prf2 (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2)))
       IsTrue.itsTrue) ⟩
    true
   end

intersectionHolds ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS []) rs2@(RS []) _ _ =
   begin
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false)) (merge2 ⦃ o ⦄ ⦃ dio ⦄ (rSetRanges rs1) (rSetRanges rs2)))
   =⟨⟩
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false)) (merge2 ⦃ o ⦄ ⦃ dio ⦄ [] []))
   =⟨⟩
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false)) [])
   =⟨⟩
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ []
   =⟨⟩
    true
   end
intersectionHolds ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ranges@(r ∷ rs)) rs2@(RS []) _ _ =
   begin
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false)) (merge2 ⦃ o ⦄ ⦃ dio ⦄ (rSetRanges rs1) (rSetRanges rs2)))
   =⟨⟩
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false)) (merge2 ⦃ o ⦄ ⦃ dio ⦄ ranges []))
   =⟨⟩
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false)) [])
   =⟨⟩
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ []
   =⟨⟩
    true
   end

intersectionHolds ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS []) rs2@(RS ranges@(r ∷ rs)) _ _ =
   begin
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false)) (merge2 ⦃ o ⦄ ⦃ dio ⦄ (rSetRanges rs1) (rSetRanges rs2)))
   =⟨⟩
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false)) (merge2 ⦃ o ⦄ ⦃ dio ⦄ [] ranges))
   =⟨⟩
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ (filter (λ x → (rangeIsEmpty ⦃ o ⦄ ⦃ dio ⦄ x == false)) [])
   =⟨⟩
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ []
   =⟨⟩
    true
   end

intersectionHolds ⦃ o ⦄ ⦃ dio ⦄ rs1@(RS ranges1@(r1 ∷ rss1)) rs2@(RS ranges2@(r2 ∷ rss2)) prf1 prf2 =
   begin
    validRangeList (filter (λ x → (rangeIsEmpty x == false)) (merge2 (rSetRanges rs1) (rSetRanges rs2)))
   =⟨⟩
    validRangeList (filter (λ x → (rangeIsEmpty x == false))
      ((rangeIntersection r1 r2) ∷ (if_then_else_ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2) (merge2 rss1 ranges2) (merge2 ranges1 rss2))))
   =⟨⟩
    validRangeList (
       if_then_else_ (rangeIsEmpty (rangeIntersection r1 r2) == false)

      ((rangeIntersection r1 r2) ∷ (filter (λ x → (rangeIsEmpty x == false))
       (if_then_else_ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2) (merge2 rss1 ranges2) (merge2 ranges1 rss2))))

       (filter (λ x → (rangeIsEmpty x == false))
         (if_then_else_ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r1 < rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r2) (merge2 rss1 ranges2) (merge2 ranges1 rss2)))
      )
   =⟨ intersection2 ⦃ o ⦄ ⦃ dio ⦄ rs1 rs2 prf1 prf2 (rangeIsEmpty (rangeIntersection r1 r2) == false) ⟩
     true
   end

validRanges1 ⦃ o ⦄ ⦃ dio ⦄ [] =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 [])
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ []
   =⟨⟩
      true
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ []
   end
validRanges1 ⦃ o ⦄ ⦃ dio ⦄ (BoundaryAboveAll ∷ []) =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ (BoundaryAboveAll  ∷ []))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ []
   =⟨⟩
      true
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (BoundaryAboveAll ∷ [])
   end
validRanges1 ⦃ o ⦄ ⦃ dio ⦄ (BoundaryBelowAll ∷ []) =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ (BoundaryBelowAll ∷ []))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg BoundaryBelowAll BoundaryAboveAll) ∷ [])
   =⟨⟩
      true
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (BoundaryBelowAll ∷ [])
   end
validRanges1 ⦃ o ⦄ ⦃ dio ⦄ ((BoundaryAbove x) ∷ []) =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ ((BoundaryAbove x) ∷ []))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg (BoundaryAbove x) BoundaryAboveAll) ∷ [])
   =⟨⟩
      (BoundaryAbove x) <= BoundaryAboveAll
   =⟨⟩
      true
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ ((BoundaryAbove x) ∷ [])
   end
validRanges1 ⦃ o ⦄ ⦃ dio ⦄ ((BoundaryBelow x) ∷ []) =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ ((BoundaryBelow x) ∷ []))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg (BoundaryBelow x) (BoundaryAboveAll)) ∷ [])
   =⟨⟩
      (BoundaryBelow x) <= BoundaryAboveAll
   =⟨⟩
      true
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ ((BoundaryBelow x) ∷ [])
   end

validRanges1 ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ []) =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ []))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg b1 b2) ∷ ranges1([]))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg b1 b2) ∷ [])
   =⟨⟩
      (b1 <= b2)
   =⟨ sym (prop_and_true (b1 <= b2)) ⟩
      ((b1 <= b2) && true)
   =⟨⟩
      ((b1 <= b2) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ []))
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ [])
   end

validRanges1 ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs@(b3@(BoundaryBelow x) ∷ [])) =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg b1 b2) ∷ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ bs))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg b1 b2) ∷ (Rg b3 (BoundaryAboveAll)) ∷ [])
   =⟨⟩
      ((okAdjacent (Rg b1 b2) (Rg b3 (BoundaryAboveAll))) && (validRangeList ⦃ o ⦄ ⦃ dio ⦄ []))
   =⟨⟩
      ((okAdjacent (Rg b1 b2) (Rg b3 BoundaryAboveAll)) && true)
   =⟨⟩
      (((b1 <= b2) && (b2 <= b3) && (b3 <= BoundaryAboveAll)) && true)
   =⟨ prop_and_true ((b1 <= b2) && (b2 <= b3) && (b3 <= BoundaryAboveAll)) ⟩
      ((b1 <= b2) && (b2 <= b3) && true)
   =⟨⟩
      ((b1 <= b2) && (b2 <= b3) && (validBoundaryList (b3 ∷ [])))
   =⟨⟩
       ((b1 <= b2) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b2 ∷ b3 ∷ [])))
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs)
   end

validRanges1 ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs@(b3@(BoundaryAbove x) ∷ [])) =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg b1 b2) ∷ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ bs))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg b1 b2) ∷ (Rg b3 (BoundaryAboveAll)) ∷ [])
   =⟨⟩
      ((okAdjacent (Rg b1 b2) (Rg b3 BoundaryAboveAll)) && (validRangeList ⦃ o ⦄ ⦃ dio ⦄ []))
   =⟨⟩
      ((okAdjacent (Rg b1 b2) (Rg b3 BoundaryAboveAll)) && true)
   =⟨⟩
      (((b1 <= b2) && (b2 <= b3) && (b3 <= BoundaryAboveAll)) && true)
   =⟨ prop_and_true ((b1 <= b2) && (b2 <= b3) && (b3 <= BoundaryAboveAll)) ⟩
      ((b1 <= b2) && (b2 <= b3) && true)
   =⟨⟩
      ((b1 <= b2) && (b2 <= b3) && (validBoundaryList (b3 ∷ [])))
   =⟨⟩
       ((b1 <= b2) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b2 ∷ b3 ∷ [])))
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs)
   end

validRanges1 ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs@(b3@(BoundaryBelowAll) ∷ [])) =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg b1 b2) ∷ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ bs))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg b1 b2) ∷ (Rg b3 (BoundaryAboveAll)) ∷ [])
   =⟨⟩
      ((okAdjacent (Rg b1 b2) (Rg b3 (BoundaryAboveAll))) && (validRangeList ⦃ o ⦄ ⦃ dio ⦄ []))
   =⟨⟩
      ((okAdjacent (Rg b1 b2) (Rg b3 (BoundaryAboveAll))) && true)
   =⟨⟩
      (((b1 <= b2) && (b2 <= b3) && (b3 <= (BoundaryAboveAll))) && true)
   =⟨ prop_and_true ((b1 <= b2) && (b2 <= b3) && (b3 <= (BoundaryAboveAll))) ⟩
      ((b1 <= b2) && (b2 <= b3) && true)
   =⟨⟩
      ((b1 <= b2) && (b2 <= b3) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b3 ∷ [])))
   =⟨⟩
       ((b1 <= b2) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b2 ∷ b3 ∷ [])))
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs)
   end

validRanges1 ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs@(b3@(BoundaryAboveAll) ∷ [])) =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄  (b1 ∷ b2 ∷ bs))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg b1 b2) ∷ (ranges1 ⦃ o ⦄ ⦃ dio ⦄  bs))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄  ((Rg b1 b2) ∷ [])
   =⟨⟩
      (b1 <= b2)
   =⟨ sym (prop_and_true (b1 <= b2)) ⟩
      ((b1 <= b2) && true)
   =⟨⟩
      ((b1 <= b2) && (b2 <= b3))
   =⟨ sym (prop_and_true ((b1 <= b2) && (b2 <= b3))) ⟩
      (((b1 <= b2) && (b2 <= b3)) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄  (b3 ∷ [])))
   =⟨ prop_and_assoc (b1 <= b2) (b2 <= b3) (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄  (b3 ∷ [])) ⟩
      ((b1 <= b2) && (b2 <= b3) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄  (b3 ∷ [])))
   =⟨⟩
      ((b1 <= b2) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b2 ∷ b3 ∷ [])))
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs)
   end

validRanges1 ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs@(b3 ∷ bss@(b4 ∷ bsss))) =
   begin
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ (ranges1 ⦃ o ⦄ ⦃ dio ⦄  (b1 ∷ b2 ∷ bs))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄ ((Rg b1 b2) ∷ (ranges1 ⦃ o ⦄ ⦃ dio ⦄  bs))
   =⟨⟩
      validRangeList ⦃ o ⦄ ⦃ dio ⦄  ((Rg b1 b2) ∷ (Rg b3 b4) ∷ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ bsss))
   =⟨⟩
      (okAdjacent (Rg b1 b2) (Rg b3 b4)) && validRangeList ((Rg b3 b4) ∷ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ bsss))
   =⟨⟩
      (((b1 <= b2) && (b2 <= b3) && (b3 <= b4)) && (validRangeList ((Rg b3 b4) ∷ (ranges1 ⦃ o ⦄ ⦃ dio ⦄ bsss))))
   =⟨⟩
      (((b1 <= b2) && (b2 <= b3) && (b3 <= b4)) && (validRangeList (ranges1 ⦃ o ⦄ ⦃ dio ⦄ bs)))
   =⟨ cong (((b1 <= b2) && (b2 <= b3) && (b3 <= b4)) &&_) (validRanges1 ⦃ o ⦄ ⦃ dio ⦄ bs) ⟩
      (((b1 <= b2) && ((b2 <= b3) && (b3 <= b4))) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bs))
   =⟨ prop_and_assoc (b1 <= b2) ((b2 <= b3) && (b3 <= b4)) (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bs) ⟩
      ((b1 <= b2) && (((b2 <= b3) && (b3 <= b4)) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bs)))
   =⟨ cong ((b1 <= b2) &&_) (prop_and_assoc (b2 <= b3) (b3 <= b4) (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bs)) ⟩
      ((b1 <= b2) && ((b2 <= b3) && (b3 <= b4) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bs)))
   =⟨⟩
      ((b1 <= b2) && ((b2 <= b3) && (b3 <= b4) && (b3 <= b4 && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bss))))
   =⟨ cong ((b1 <= b2) &&_) (cong (b2 <= b3 &&_) (prop_and_cancel (b3 <= b4))) ⟩
      ((b1 <= b2) && (b2 <= b3) && (b3 <= b4) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bss))
   =⟨⟩
      ((b1 <= b2) && (b2 <= b3) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bs))
   =⟨⟩
      ((b1 <= b2) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b2 ∷ bs)))
   =⟨⟩
      validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (b1 ∷ b2 ∷ bs)
   end

validSetBounds ⦃ o ⦄ ⦃ dio ⦄ [] =
  begin
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (setBounds1 ⦃ o ⦄ ⦃ dio ⦄ [])
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ []
   end

validSetBounds ⦃ o ⦄ ⦃ dio ⦄ bs@(BoundaryBelowAll ∷ []) =
  begin
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (setBounds1 ⦃ o ⦄ ⦃ dio ⦄ bs)
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ []
  =⟨⟩
   true
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bs
   end

validSetBounds ⦃ o ⦄ ⦃ dio ⦄ bs@(b0@(BoundaryBelowAll) ∷ bss@(b1 ∷ b2)) =
  begin
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (setBounds1 ⦃ o ⦄ ⦃ dio ⦄ bs)
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bss
  =⟨⟩
    (true && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bss))
  =⟨ cong (_&& (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ bss)) (sym (BoundaryBelowAllSmaller ⦃ o ⦄ ⦃ dio ⦄ b1)) ⟩
    ((BoundaryBelowAll <= b1) && (validBoundaryList bss))
  =⟨⟩
    validBoundaryList bs
  end

validSetBounds ⦃ o ⦄ ⦃ dio ⦄ bs@(b@(BoundaryBelow x) ∷ bss) =
  begin
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (setBounds1 ⦃ o ⦄ ⦃ dio ⦄ bs)
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (BoundaryBelowAll ∷ bs)
  =⟨⟩
    ((BoundaryBelowAll <= b) && (validBoundaryList bs))
  =⟨⟩
    (true && (validBoundaryList bs))
  =⟨⟩
    (validBoundaryList bs)
   end

validSetBounds ⦃ o ⦄ ⦃ dio ⦄ bs@(b@(BoundaryAboveAll) ∷ bss) =
  begin
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (setBounds1 ⦃ o ⦄ ⦃ dio ⦄ bs)
  =⟨⟩
    validBoundaryList (BoundaryBelowAll ∷ bs)
  =⟨⟩
    ((BoundaryBelowAll <= b) && (validBoundaryList bs))
  =⟨⟩
    (true && (validBoundaryList bs))
  =⟨⟩
    (validBoundaryList bs)
   end
validSetBounds ⦃ o ⦄ ⦃ dio ⦄ bs@(b@(BoundaryAbove x) ∷ bss) =
  begin
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (setBounds1 ⦃ o ⦄ ⦃ dio ⦄ bs)
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (BoundaryBelowAll ∷ bs)
  =⟨⟩
    ((BoundaryBelowAll <= b) && (validBoundaryList bs))
  =⟨⟩
    (true && (validBoundaryList bs))
  =⟨⟩
    (validBoundaryList bs)
   end

valid ⦃ o ⦄ ⦃ dio ⦄ rs@(RS []) {_} =
  begin
     validRangeList ⦃ o ⦄ ⦃ dio ⦄ (rSetRanges rs)
  =⟨⟩
    validRangeList ⦃ o ⦄ ⦃ dio ⦄ []
  =⟨⟩
    true
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ []
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ [])
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ (rSetRanges rs))
  end
valid ⦃ o ⦄ ⦃ dio ⦄ rs@(RS (r ∷ [])) {_} =
  begin
     validRangeList ⦃ o ⦄ ⦃ dio ⦄ (rSetRanges rs)
  =⟨⟩
     validRangeList ⦃ o ⦄ ⦃ dio ⦄ (r ∷ [])
  =⟨⟩
    ((rangeLower ⦃ o ⦄ ⦃ dio ⦄  r) <= (rangeUpper ⦃ o ⦄ ⦃ dio ⦄  r))
  =⟨ sym (prop_and_true ((rangeLower ⦃ o ⦄ ⦃ dio ⦄  r) <= (rangeUpper ⦃ o ⦄ ⦃ dio ⦄  r))) ⟩
    (((rangeLower ⦃ o ⦄ ⦃ dio ⦄  r) <= (rangeUpper ⦃ o ⦄ ⦃ dio ⦄  r)) && true)
  =⟨⟩
    (((rangeLower ⦃ o ⦄ ⦃ dio ⦄  r) <= (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r)) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ []))
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ ((rangeLower ⦃ o ⦄ ⦃ dio ⦄  r) ∷ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄ r) ∷ [])
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ (r ∷ []))
  =⟨⟩
    validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ (rSetRanges rs))
  end

valid ⦃ o ⦄ ⦃ dio ⦄ rs@(RS ranges@(r@(Rg l1 u1) ∷ r1@(r2@(Rg l2 u2) ∷ rss))) {prf} =
  begin
     validRangeList ⦃ o ⦄ ⦃ dio ⦄ (rSetRanges rs)
  =⟨⟩
     validRangeList ⦃ o ⦄ ⦃ dio ⦄ (r ∷ (r2 ∷ rss))
  =⟨⟩
     ((okAdjacent r r2) && (validRangeList ⦃ o ⦄ ⦃ dio ⦄ r1))
  =⟨⟩
    ((l1 <= u1 && (u1 <= l2 && l2 <= u2)) && (validRangeList ⦃ o ⦄ ⦃ dio ⦄ r1))
  =⟨ cong ((l1 <= u1 && u1 <= l2 && l2 <= u2) &&_) (valid ⦃ o ⦄ ⦃ dio ⦄ (RS r1 {headandtail rs prf}) {headandtail rs prf}) ⟩
     ((l1 <= u1 && (u1 <= l2 && l2 <= u2)) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ r1)))
  =⟨ prop_and_assoc (l1 <= u1) (u1 <= l2 && l2 <= u2) (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ r1)) ⟩
    (l1 <= u1 && ((u1 <= l2  && l2 <= u2) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ r1))))
  =⟨ cong (l1 <= u1 &&_) (prop_and_assoc (u1 <= l2) (l2 <= u2) (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ r1))) ⟩
    (l1 <= u1 && u1 <= l2  && (l2 <= u2  && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ r1))))
  =⟨⟩
    (l1 <= u1 && u1 <= l2  && (l2 <= u2
         && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ ((rangeLower ⦃ o ⦄ ⦃ dio ⦄  r2) ∷ (rangeUpper ⦃ o ⦄ ⦃ dio ⦄  r2) ∷ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ rss)))))
  =⟨⟩
    (l1 <= u1 && u1 <= l2 && l2 <= u2 && l2 <= u2
         && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ ((rangeUpper ⦃ o ⦄ ⦃ dio ⦄  r2) ∷ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ rss))))
  =⟨ cong (l1 <= u1 &&_) (cong (u1 <= l2 &&_) (prop_and_cancel (l2 <= u2))) ⟩
    (l1 <= u1 && u1 <= l2 && ((l2 <= u2) && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (u2 ∷ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ rss)))))
  =⟨⟩
    (l1 <= u1 && u1 <= l2 && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (l2 ∷ (u2 ∷ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ rss)))))
  =⟨⟩
    (l1 <= u1 && (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (u1 ∷ l2 ∷ u2 ∷ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ rss))))
  =⟨⟩
   (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (l1 ∷ u1 ∷ l2 ∷ u2 ∷ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ rss)))
  =⟨⟩
   (validBoundaryList ⦃ o ⦄ ⦃ dio ⦄ (bounds1 ⦃ o ⦄ ⦃ dio ⦄ ranges))
  end


module _ (A : Set) where

data A where


module Issue329 where

mutual
  infixl 0 D Undeclared
  data D : Set where


open import Data.List using ( [] )
open import Data.Product using ( proj₁ ; proj₂ )
open import Data.Sum using ( _⊎_ ; inj₁ ; inj₂ )
open import Relation.Binary.PropositionalEquality using ( refl )
open import Web.Semantic.DL.ABox.Interp using ( ⌊_⌋ ; ind ; _*_ )
open import Web.Semantic.DL.ABox.Interp.Morphism using ( _,_ )
open import Web.Semantic.DL.ABox.Model using
  ( _⊨a_ ; on-bnode ; bnodes ; _,_ ; ⊨a-resp-≲ )
open import Web.Semantic.DL.Category.Composition using ( _∙_ )
open import Web.Semantic.DL.Category.Properties.Composition.Assoc using
  ( compose-assoc )
open import Web.Semantic.DL.Category.Properties.Composition.Lemmas using
  ( compose-left ; compose-right ; compose-resp-⊨a )
open import Web.Semantic.DL.Category.Properties.Composition.RespectsEquiv using
  ( compose-resp-≣ )
open import Web.Semantic.DL.Category.Properties.Equivalence using
  ( ≣-refl ; ≣-sym ; ≣-trans )
open import Web.Semantic.DL.Category.Properties.Tensor.Coherence using
  ( symm-unit )
open import Web.Semantic.DL.Category.Properties.Tensor.Lemmas using
  ( tensor-up ; tensor-down ; tensor-resp-⊨a )
open import Web.Semantic.DL.Category.Properties.Tensor.SymmNatural using
  ( symm-natural )
open import Web.Semantic.DL.Category.Object using ( Object ; IN ; fin )
open import Web.Semantic.DL.Category.Morphism using
  ( _⇒_ ; BN ; impl ; _⊑_ ; _≣_ ; _,_ )
open import Web.Semantic.DL.Category.Tensor using ( _⟨⊗⟩_ )
open import Web.Semantic.DL.Category.Unit using ( I )
open import Web.Semantic.DL.Category.Wiring using
  ( wires-≈ ; wires-≈⁻¹ ; identity ; unit₁ ; unit₂ ; symm )
open import Web.Semantic.DL.Signature using ( Signature )
open import Web.Semantic.DL.TBox using ( TBox )
open import Web.Semantic.DL.TBox.Interp using ( Δ ; _⊨_≈_ ; ≈-refl ; ≈-sym )
open import Web.Semantic.DL.TBox.Interp.Morphism using ( ≲-refl )
open import Web.Semantic.Util using
  ( _∘_ ; False ; _⊕_⊕_ ; inode ; bnode ; enode ; left ; right ; up ; down )

module Web.Semantic.DL.Category.Properties.Tensor.UnitNatural
  {Σ : Signature} {S T : TBox Σ} where

unit₁-natural : ∀ {A B : Object S T} (F : A ⇒ B) →
  ((identity I ⟨⊗⟩ F) ∙ unit₁ B ≣ unit₁ A ∙ F)
unit₁-natural {A} {B} F = (LHS⊑RHS , RHS⊑LHS) where

  LHS⊑RHS : ((identity I ⟨⊗⟩ F) ∙ unit₁ B ⊑ unit₁ A ∙ F)
  LHS⊑RHS J J⊨STA J⊨LHS = (f , J⊨RHS) where

    f : False ⊕ IN A ⊕ BN F → Δ ⌊ J ⌋
    f (inode ())
    f (bnode x) = ind J (inode (inj₂ x))
    f (enode v) = ind J (bnode (inode (inj₂ v)))

    f✓ : ∀ x → ⌊ J ⌋ ⊨ ind J (left (down x)) ≈ on-bnode f (ind J) (right x)
    f✓ (inode x) = ≈-refl ⌊ J ⌋
    f✓ (bnode v) = ≈-refl ⌊ J ⌋
    f✓ (enode y) = wires-≈ inj₂ (proj₂ (fin B) y)
      (compose-right (identity I ⟨⊗⟩ F) (unit₁ B) J J⊨LHS)

    J⊨RHS : bnodes J f ⊨a impl (unit₁ A ∙ F)
    J⊨RHS = compose-resp-⊨a (unit₁ A) F (bnodes J f)
      (wires-≈⁻¹ inj₂ (λ x → ≈-refl ⌊ J ⌋) (proj₁ (fin A)))
      (⊨a-resp-≲ (≲-refl ⌊ J ⌋ , f✓) (impl F)
        (tensor-down (identity I) F (left * J)
          (compose-left (identity I ⟨⊗⟩ F) (unit₁ B) J J⊨LHS)))

  RHS⊑LHS : (unit₁ A ∙ F ⊑ (identity I ⟨⊗⟩ F) ∙ unit₁ B)
  RHS⊑LHS J J⊨STA J⊨RHS = (f , J⊨LHS) where

    f : ((False ⊎ BN F) ⊕ (False ⊎ IN B) ⊕ False) → Δ ⌊ J ⌋
    f (inode (inj₁ ()))
    f (inode (inj₂ v)) = ind J (bnode (enode v))
    f (bnode (inj₁ ()))
    f (bnode (inj₂ y)) = ind J (enode y)
    f (enode ())

    f✓ : ∀ x → ⌊ J ⌋ ⊨ ind J (right x) ≈ on-bnode f (ind J) (left (down x))
    f✓ (inode x) = ≈-sym ⌊ J ⌋ (wires-≈ inj₂ (proj₂ (fin A) x) (compose-left (unit₁ A) F J J⊨RHS))
    f✓ (bnode v) = ≈-refl ⌊ J ⌋
    f✓ (enode y) = ≈-refl ⌊ J ⌋

    J⊨LHS : bnodes J f ⊨a impl ((identity I ⟨⊗⟩ F) ∙ unit₁ B)
    J⊨LHS = compose-resp-⊨a (identity I ⟨⊗⟩ F) (unit₁ B) (bnodes J f)
      (tensor-resp-⊨a (identity I) F (left * bnodes J f)
        (wires-≈⁻¹ {I = up * left * bnodes J f} (λ ()) (λ ()) [])
        (⊨a-resp-≲ (≲-refl ⌊ J ⌋ , f✓) (impl F)
          (compose-right (unit₁ A) F J J⊨RHS)))
      (wires-≈⁻¹ inj₂ (λ x → ≈-refl ⌊ J ⌋) (proj₁ (fin B)))

unit₂-natural : ∀ {A B : Object S T} (F : A ⇒ B) →
  ((F ⟨⊗⟩ identity I) ∙ unit₂ B ≣ unit₂ A ∙ F)
unit₂-natural {A} {B} F =
  ≣-trans
    (compose-resp-≣ (≣-refl (F ⟨⊗⟩ identity I)) (≣-sym (symm-unit B)))
  (≣-trans
    (≣-sym (compose-assoc (F ⟨⊗⟩ identity I) (symm B I) (unit₁ B)))
  (≣-trans
    (compose-resp-≣ (symm-natural F (identity I)) (≣-refl (unit₁ B)))
  (≣-trans
    (compose-assoc (symm A I) (identity I ⟨⊗⟩ F) (unit₁ B))
  (≣-trans
    (compose-resp-≣ (≣-refl (symm A I)) (unit₁-natural F))
  (≣-trans
    (≣-sym (compose-assoc (symm A I) (unit₁ A) F))
    (compose-resp-≣ (symm-unit A) (≣-refl F)))))))


open import Data.Bool

module GUIgeneric.GUIExample   where

open import GUIgeneric.Prelude renaming (inj₁ to secondBtn; inj₂ to firstBtn; WxColor to Color) hiding (addButton; _>>_)

open import GUIgeneric.GUIDefinitions renaming (add to add'; add' to add)
open import GUIgeneric.GUI
open import GUIgeneric.GUIExampleLib renaming (addButton to addButton')

open import Data.Product

addButton : String → Frame → Frame
addButton str fr = addButton' str fr optimized

addTxtBox : String → Frame → Frame
addTxtBox str fr = addTxtBox' str fr optimized

oneBtnGUI : Frame
oneBtnGUI = addButton "OK" create-frame

twoBtnGUI : Frame
twoBtnGUI = addButton "Cancel" oneBtnGUI

-- Attributes
--
Cols = ℕ
Margin  = ℕ
HSpace  = ℕ
VSpace  = ℕ

oneColumnLayout : Cols × Margin × HSpace × VSpace
oneColumnLayout = (1 , 10 , 2 , 2)

black : Color
black = rgb 0 0 0

propOneBtn : properties oneBtnGUI
propOneBtn = black , oneColumnLayout

propTwoBtn : properties twoBtnGUI
propTwoBtn = black , black , oneColumnLayout

putStr' : {A : Set} → String → (f : IO GuiLev1Interface ∞ A) →
           IO GuiLev1Interface ∞ A
putStr' s f = do (putStrLn s) (λ _ → f)

syntax putStr' s f = putStrLn s >> f

keepGUI : {j : Size} → HandlerObject j twoBtnGUI →
            IO GuiLev1Interface ∞
      (Σ-syntax (returnType twoBtnGUI)
       (λ r →
          IOObjectˢ GuiLev1Interface handlerInterface j
          (nextStateFrame twoBtnGUI r)))
keepGUI = λ obj → return (noChange , obj)

changeGUI : ∀ {j} (g : CompEls frame) {g'} (prop : properties g) obj →
              IO GuiLev1Interface ∞ (Σ (returnType g') (\r -> IOObjectˢ GuiLev1Interface handlerInterface j (nextStateFrame g' r)))
changeGUI = λ g prop obj →  return (changedGUI g prop , obj)

mutual
 objTwoBtnGUI' : ∀ i → HandlerObject i twoBtnGUI
 objTwoBtnGUI' i .method {j} (secondBtn bt) =
   putStrLn "Cancel Fired! NO GUI Change." >>
   keepGUI (objTwoBtnGUI' j)

 objTwoBtnGUI' i .method {j} (firstBtn bt) =
   putStrLn "OK Fired! Redefining GUI." >>
   changeGUI oneBtnGUI propOneBtn (objOneBtnGUI' j)

 objOneBtnGUI' : ∀ i → HandlerObject i oneBtnGUI
 objOneBtnGUI' i .method {j} bt =
    putStrLn "OK Fired! Redefining GUI." >>
    changeGUI twoBtnGUI propTwoBtn (objTwoBtnGUI' j)

 obj2Btn : ∀ {i} → HandlerObject i twoBtnGUI
 obj2Btn .method (firstBtn bt) =
   putStrLn "OK fired! Redefining GUI." >>
   changeGUI oneBtnGUI propOneBtn obj1Btn
 obj2Btn .method (secondBtn bt) =
   putStrLn "Cancel fired! No GUI change." >>
   keepGUI obj2Btn

 obj1Btn : ∀ {i} → HandlerObject i oneBtnGUI
 obj1Btn .method bt =
    putStrLn "OK fired! Redefining GUI." >>
    changeGUI twoBtnGUI propTwoBtn obj2Btn

main : NativeIO Unit
main = compileProgram  twoBtnGUI propTwoBtn
                       (obj2Btn {∞})


------------------------------------------------------------------------------
-- Test the consistency of FOTC.Data.List
------------------------------------------------------------------------------

{-# OPTIONS --exact-split              #-}
{-# OPTIONS --no-sized-types           #-}
{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K                #-}

-- In the module FOTC.Data.List we declare Agda postulates as FOL
-- axioms. We test if it is possible to prove an unprovable theorem
-- from these axioms.

module FOTC.Data.List.Consistency.Axioms where

open import FOTC.Base
open import FOTC.Data.List

------------------------------------------------------------------------------

postulate impossible : ∀ d e → d ≡ e
{-# ATP prove impossible #-}


open import Structures --using (KS; SKS; ks; TCS; Prog; monadTC; _⊕_; Err; ok; error; list-has-el; lift-state; lift-mstate)
open import Reflection as RE hiding (return; _>>=_; _>>_)
open import Reflection.Show

module Extract (kompile-fun : Type → Term → Name → SKS Prog) where

open import Reflection.Term
import      Reflection.Name as RN
open import Agda.Builtin.Reflection using (withReconstructed; dontReduceDefs; onlyReduceDefs)

open import Data.List as L hiding (_++_)
open import Data.Unit using (⊤)
open import Data.Product
open import Data.Bool
open import Data.String as S hiding (_++_)
open import Data.Maybe as M hiding (_>>=_)

open import Function --using (_$_; case_of_)

open import ReflHelper

open import Category.Monad using (RawMonad)
open import Category.Monad.State using (StateTMonadState; RawMonadState)
open RawMonad {{...}} public

{-# TERMINATING #-}
kompile-fold   : TCS Prog

macro
  -- Main entry point of the extractor.
  -- `n` is a starting function of the extraction
  -- `base` is the set of base functions that we never traverse into.
  -- `skip` is the list of functions that we have traversed already.
  -- The difference between the two is that `base` would be passed to
  -- `dontReduceDefs`, hence never inlined; whereas `skip` mainly avoids
  -- potential recursive extraction.
  kompile : Name → Names → Names → Term → TC ⊤
  kompile n base skip hole = do
    (p , st) ← kompile-fold $ ks [ n ] base skip ε 1
    --let p = KS.defs st ⊕ p
    q ← quoteTC p
    unify hole q

-- Traverse through the list of the functions we need to extract
-- and collect all the definitions.
kompile-fold = do
    s@(ks fs ba done _ c) ← R.get
    case fs of λ where
      []       → return ε
      (f ∷ fs) → case list-has-el (f RN.≟_) done of λ where
        true → do
          R.modify λ k → record k{ funs = fs }
          kompile-fold
        false → do
          (ty , te) ← lift-state {RM = monadTC} $ do
              ty ← getType f
              ty ← withReconstructed $ dontReduceDefs ba $ normalise ty
              te ← withReconstructed $ getDefinition f >>= λ where
                    (function cs) → return $ pat-lam cs []
                    -- FIXME: currently we do not extract data types, which
                    --        we should fix by parametrising this module by
                    --        kompile-type argument, and calling it in the
                    --        same way as we call kompile-fun now.
                    --(data-cons d) → return $ con d []
                    _ → return unknown
              te ← pat-lam-norm te ba
              return $ ty , te
          case te of λ where
            unknown →
              return $ error $ "kompile: attempting to compile `" ++ showName f ++ "` as function"
            _ → do
                R.put (ks fs ba (f ∷ done) ε c)
                -- Compile the function and make an error more specific in
                -- case compilation fails.
                (ok q) ← lift-mstate {RM = monadTC} $ kompile-fun ty te f
                  where (error x) → return $ error $ "in function " ++ showName f ++ ": " ++ x
                defs ← KS.defs <$> R.get
                let q = defs ⊕ q
                   --R.modify $! λ k → record k{ defs = ε }
                kst ← R.get
                  --let q = KS.defs kst ⊕ q
                R.put $! record kst{ defs = ε }
                -- Do the rest of the functions
                p ← kompile-fold
                return $! p ⊕ "\n\n" ⊕ q
  where
    module R = RawMonadState (StateTMonadState KS monadTC)


{-# OPTIONS --cubical #-}

-- First and second species counterpoint for Frog's song
module Frog where

open import Data.Fin
open import Data.List using (List; []; _∷_; _++_; map)
open import Data.Maybe using (fromMaybe)
open import Data.Nat
open import Data.Product using (_×_; _,_; proj₁; proj₂)
open import Function using (_∘_)

open import Relation.Binary.PropositionalEquality using (refl)

open import Counterpoint
open import Note
open import Music
open import MidiEvent
open import Pitch
open import Interval
open import Util

-- First species counterpoint (musical content)
first : PitchInterval
first = (c 5 , per8)

middle : List PitchInterval
middle = (d 5 , maj6) ∷ (e 5 , min6) ∷ (f 5 , maj3) ∷ (e 5 , min3) ∷ (d 5 , maj6) ∷ []

middle' : List PitchInterval
middle' = (d 5 , per8) ∷ (e 5 , min6) ∷ (f 5 , maj3) ∷ (e 5 , min3) ∷ (d 5 , maj6) ∷ []

last : PitchInterval
last = (c 5 , per8)

-- Second species counterpoint (musical content)
first2 : PitchInterval
first2 = (c 5 , per5)

middle2 : List PitchInterval2
middle2 = (d 5 , min3 , per5) ∷ (e 5 , min3 , min6) ∷ (f 5 , maj3 , aug4) ∷
          (e 5 , min6 , per1) ∷ (d 5 , min3 , maj6) ∷ []

last2 : PitchInterval
last2 = (c 5 , per8)

-- Correct first species counterpoint
fs : FirstSpecies
fs = firstSpecies first middle last refl refl refl refl

{-
-- Parallel octave example from Section 3.3; ill-typed
fs' : FirstSpecies
fs' = firstSpecies first middle' last refl refl refl refl
-}

-- Correct second species counterpoint
ss : SecondSpecies
ss = secondSpecies first2 middle2 last2 refl refl refl refl refl

-- Music as list of notes
cf cp1 cp2 : List Note
cf =
  tone whole (proj₁ (FirstSpecies.firstBar fs)) ∷
  map (tone whole ∘ proj₁ ∘ pitchIntervalToPitchPair) (FirstSpecies.middleBars fs) ++
  tone whole (proj₁ (FirstSpecies.lastBar fs)) ∷
  []

cp1 =
  tone whole ((proj₂ ∘ pitchIntervalToPitchPair) (FirstSpecies.firstBar fs)) ∷
  map (tone whole ∘ proj₂ ∘ pitchIntervalToPitchPair) (FirstSpecies.middleBars fs) ++
  tone whole ((proj₂ ∘ pitchIntervalToPitchPair) (FirstSpecies.lastBar fs)) ∷
  []

cp2 =
  rest half ∷
  (tone half ((proj₂ ∘ pitchIntervalToPitchPair) (SecondSpecies.firstBar ss))) ∷
  map (tone half ∘ proj₂ ∘ pitchIntervalToPitchPair) (expandPitchIntervals2 (SecondSpecies.middleBars ss)) ++
  tone whole ((proj₂ ∘ pitchIntervalToPitchPair) (SecondSpecies.lastBar ss)) ∷
  []

----

-- MIDI generation
piano marimba : InstrumentNumber-1
piano   = # 0
marimba = # 12

channel1 channel2 : Channel-1
channel1 = # 0
channel2 = # 1

tempo : ℕ
tempo = 120

cfVelocity cpVelocity : Velocity
cfVelocity = # 60
cpVelocity = # 30

cfTrack : MidiTrack
cfTrack = track "Cantus Firmus" piano channel1 tempo (notes→events cfVelocity cf)

cpTrack1 : MidiTrack
cpTrack1 = track "Counterpoint 1" piano channel2 tempo (notes→events cpVelocity cp1)

cfcpTracks1 : List MidiTrack
cfcpTracks1 = cpTrack1 ∷ cfTrack ∷ []

cpTrack2 : MidiTrack
cpTrack2 = track "Counterpoint 2" piano channel2 tempo (notes→events cpVelocity cp2)

cfcpTracks2 : List MidiTrack
cfcpTracks2 = cpTrack2 ∷ cfTrack ∷ []


module Issue1078.A where

open import Common.Level using (Level)


{-

Descriptor language for easily defining structures

-}
{-# OPTIONS --cubical --no-import-sorts --no-exact-split --safe #-}
module Cubical.Structures.Macro where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Function
open import Cubical.Foundations.HLevels
open import Cubical.Foundations.Equiv
open import Cubical.Foundations.SIP
open import Cubical.Functions.FunExtEquiv
open import Cubical.Data.Sigma
open import Cubical.Data.Maybe

open import Cubical.Structures.Constant
open import Cubical.Structures.Function
open import Cubical.Structures.Maybe
open import Cubical.Structures.Parameterized
open import Cubical.Structures.Pointed
open import Cubical.Structures.Product

data TranspDesc (ℓ : Level) : Typeω where
  -- constant structure: X ↦ A
  constant : ∀ {ℓ'} (A : Type ℓ') → TranspDesc ℓ
  -- pointed structure: X ↦ X
  var : TranspDesc ℓ
  -- product of structures S,T : X ↦ (S X × T X)
  _,_ : (d₀ : TranspDesc ℓ) (d₁ : TranspDesc ℓ) → TranspDesc ℓ
  -- functions between structures S,T: X ↦ (S X → T X)
  function : (d₀ : TranspDesc ℓ) (d₁ : TranspDesc ℓ) → TranspDesc ℓ
  -- Maybe on a structure S: X ↦ Maybe (S X)
  maybe : TranspDesc ℓ → TranspDesc ℓ
  -- arbitrary transport structure
  foreign : ∀ {ℓ'} {S : Type ℓ → Type ℓ'} (α : EquivAction S) → TransportStr α → TranspDesc ℓ

data Desc (ℓ : Level) : Typeω where
  -- constant structure: X ↦ A
  constant : ∀ {ℓ'} (A : Type ℓ') → Desc ℓ
  -- pointed structure: X ↦ X
  var : Desc ℓ
  -- product of structures S,T : X ↦ (S X × T X)
  _,_ : (d₀ : Desc ℓ) (d₁ : Desc ℓ) → Desc ℓ
  -- functions between structures S,T : X ↦ (S X → T X)
  function : (d₀ : Desc ℓ) (d₁ : Desc ℓ) → Desc ℓ
  -- functions between structures S,T where S is functorial : X ↦ (S X → T X)
  function+ : (d₀ : TranspDesc ℓ) (d₁ : Desc ℓ) → Desc ℓ
  -- Maybe on a structure S: X ↦ Maybe (S X)
  maybe : Desc ℓ → Desc ℓ
  -- univalent structure from transport structure
  transpDesc : TranspDesc ℓ → Desc ℓ
  -- arbitrary univalent notion of structure
  foreign : ∀ {ℓ' ℓ''} {S : Type ℓ → Type ℓ'} (ι : StrEquiv S ℓ'') → UnivalentStr S ι → Desc ℓ

infixr 4 _,_

{- Transport structures -}

transpMacroLevel : ∀ {ℓ} → TranspDesc ℓ → Level
transpMacroLevel (constant {ℓ'} x) = ℓ'
transpMacroLevel {ℓ} var = ℓ
transpMacroLevel {ℓ} (d₀ , d₁) = ℓ-max (transpMacroLevel d₀) (transpMacroLevel d₁)
transpMacroLevel (function d₀ d₁) = ℓ-max (transpMacroLevel d₀) (transpMacroLevel d₁)
transpMacroLevel (maybe d) = transpMacroLevel d
transpMacroLevel (foreign {ℓ'} α τ) = ℓ'

-- Structure defined by a transport descriptor
TranspMacroStructure : ∀ {ℓ} (d : TranspDesc ℓ) → Type ℓ → Type (transpMacroLevel d)
TranspMacroStructure (constant A) X = A
TranspMacroStructure var X = X
TranspMacroStructure (d₀ , d₁) X = TranspMacroStructure d₀ X × TranspMacroStructure d₁ X
TranspMacroStructure (function d₀ d₁) X = TranspMacroStructure d₀ X → TranspMacroStructure d₁ X
TranspMacroStructure (maybe d) = MaybeStructure (TranspMacroStructure d)
TranspMacroStructure (foreign {S = S} α τ) = S

-- Action defined by a transport descriptor
transpMacroAction : ∀ {ℓ} (d : TranspDesc ℓ) → EquivAction (TranspMacroStructure d)
transpMacroAction (constant A) = constantEquivAction A
transpMacroAction var = pointedEquivAction
transpMacroAction (d₀ , d₁) = productEquivAction (transpMacroAction d₀) (transpMacroAction d₁)
transpMacroAction (function d₀ d₁) =
  functionEquivAction (transpMacroAction d₀) (transpMacroAction d₁)
transpMacroAction (maybe d) = maybeEquivAction (transpMacroAction d)
transpMacroAction (foreign α _) = α

-- Action defines a transport structure
transpMacroTransportStr : ∀ {ℓ} (d : TranspDesc ℓ) → TransportStr (transpMacroAction d)
transpMacroTransportStr (constant A) = constantTransportStr A
transpMacroTransportStr var = pointedTransportStr
transpMacroTransportStr (d₀ , d₁) =
  productTransportStr
    (transpMacroAction d₀) (transpMacroTransportStr d₀)
    (transpMacroAction d₁) (transpMacroTransportStr d₁)
transpMacroTransportStr (function d₀ d₁) =
  functionTransportStr
    (transpMacroAction d₀) (transpMacroTransportStr d₀)
    (transpMacroAction d₁) (transpMacroTransportStr d₁)
transpMacroTransportStr (maybe d) =
  maybeTransportStr (transpMacroAction d) (transpMacroTransportStr d)
transpMacroTransportStr (foreign α τ) = τ

{- General structures -}

macroStrLevel : ∀ {ℓ} → Desc ℓ → Level
macroStrLevel (constant {ℓ'} x) = ℓ'
macroStrLevel {ℓ} var = ℓ
macroStrLevel {ℓ} (d₀ , d₁) = ℓ-max (macroStrLevel d₀) (macroStrLevel d₁)
macroStrLevel {ℓ} (function+ d₀ d₁) = ℓ-max (transpMacroLevel d₀) (macroStrLevel d₁)
macroStrLevel (function d₀ d₁) = ℓ-max (macroStrLevel d₀) (macroStrLevel d₁)
macroStrLevel (maybe d) = macroStrLevel d
macroStrLevel (transpDesc d) = transpMacroLevel d
macroStrLevel (foreign {ℓ'} _ _) = ℓ'

macroEquivLevel : ∀ {ℓ} → Desc ℓ → Level
macroEquivLevel (constant {ℓ'} x) = ℓ'
macroEquivLevel {ℓ} var = ℓ
macroEquivLevel (d₀ , d₁) = ℓ-max (macroEquivLevel d₀) (macroEquivLevel d₁)
macroEquivLevel {ℓ} (function+ d₀ d₁) = ℓ-max (transpMacroLevel d₀) (macroEquivLevel d₁)
macroEquivLevel (function d₀ d₁) = ℓ-max (macroStrLevel d₀) (ℓ-max (macroEquivLevel d₀) (macroEquivLevel d₁))
macroEquivLevel (maybe d) = macroEquivLevel d
macroEquivLevel (transpDesc d) = transpMacroLevel d
macroEquivLevel (foreign {ℓ'' = ℓ''} _ _) = ℓ''

-- Structure defined by a descriptor
MacroStructure : ∀ {ℓ} (d : Desc ℓ) → Type ℓ → Type (macroStrLevel d)
MacroStructure (constant A) X = A
MacroStructure var X = X
MacroStructure (d₀ , d₁) X = MacroStructure d₀ X × MacroStructure d₁ X
MacroStructure (function+ d₀ d₁) X = TranspMacroStructure d₀ X → MacroStructure d₁ X
MacroStructure (function d₀ d₁) X = MacroStructure d₀ X → MacroStructure d₁ X
MacroStructure (maybe d) = MaybeStructure (MacroStructure d)
MacroStructure (transpDesc d) = TranspMacroStructure d
MacroStructure (foreign {S = S} _ _) = S

-- Notion of structured equivalence defined by a descriptor
MacroEquivStr : ∀ {ℓ} → (d : Desc ℓ) → StrEquiv {ℓ} (MacroStructure d) (macroEquivLevel d)
MacroEquivStr (constant A) = ConstantEquivStr A
MacroEquivStr var = PointedEquivStr
MacroEquivStr (d₀ , d₁) = ProductEquivStr (MacroEquivStr d₀) (MacroEquivStr d₁)
MacroEquivStr (function+ d₀ d₁) = FunctionEquivStr+ (transpMacroAction d₀) (MacroEquivStr d₁)
MacroEquivStr (function d₀ d₁) = FunctionEquivStr (MacroEquivStr d₀) (MacroEquivStr d₁)
MacroEquivStr (maybe d) = MaybeEquivStr (MacroEquivStr d)
MacroEquivStr (transpDesc d) = EquivAction→StrEquiv (transpMacroAction d)
MacroEquivStr (foreign ι _) = ι

-- Proof that structure induced by descriptor is univalent
MacroUnivalentStr : ∀ {ℓ} → (d : Desc ℓ) → UnivalentStr (MacroStructure d) (MacroEquivStr d)
MacroUnivalentStr (constant A) = constantUnivalentStr A
MacroUnivalentStr var = pointedUnivalentStr
MacroUnivalentStr (d₀ , d₁) =
  productUnivalentStr
    (MacroEquivStr d₀) (MacroUnivalentStr d₀)
    (MacroEquivStr d₁) (MacroUnivalentStr d₁)
MacroUnivalentStr (function+ d₀ d₁) =
  functionUnivalentStr+
    (transpMacroAction d₀) (transpMacroTransportStr d₀)
    (MacroEquivStr d₁) (MacroUnivalentStr d₁)
MacroUnivalentStr (function d₀ d₁) =
  functionUnivalentStr
    (MacroEquivStr d₀) (MacroUnivalentStr d₀)
    (MacroEquivStr d₁) (MacroUnivalentStr d₁)
MacroUnivalentStr (maybe d) = maybeUnivalentStr (MacroEquivStr d) (MacroUnivalentStr d)
MacroUnivalentStr (transpDesc d) =
  TransportStr→UnivalentStr (transpMacroAction d) (transpMacroTransportStr d)
MacroUnivalentStr (foreign _ θ) = θ

-- Module for easy importing
module Macro ℓ (d : Desc ℓ) where

  structure = MacroStructure d
  equiv = MacroEquivStr d
  univalent = MacroUnivalentStr d


------------------------------------------------------------------------
-- The Agda standard library
--
-- This module is DEPRECATED. Please use `Data.Vec.Functional` instead.
------------------------------------------------------------------------

{-# OPTIONS --without-K --safe #-}

-- Disabled to prevent warnings from other Table modules
{-# OPTIONS --warn=noUserWarning #-}

module Data.Table.Relation.Equality where

open import Data.Table.Relation.Binary.Equality public

{-# WARNING_ON_IMPORT
"Data.Table.Relation.Equality was deprecated in v1.0.
Use Data.Vec.Functional.Relation.Binary.Pointwise instead."
#-}


test = forall _⦇_ → Set


{-# OPTIONS --without-K #-}

module M-types.Base where
    open import M-types.Base.Core public
    open import M-types.Base.Sum public
    open import M-types.Base.Prod public
    open import M-types.Base.Eq public
    open import M-types.Base.Equi public
    open import M-types.Base.Rel public
    open import M-types.Base.Contr public
    open import M-types.Base.Axiom public


-- Andreas, 2017-12-04, issue #2862, reported by m0davis, case for records
-- Regression in development version 2.5.4

-- Scope checker allowed definition in different module than signature

module _ where

module N where
  record R : Set where

open N hiding (module R)

module M where
  record R where  -- should be rejected since signature lives in different module

  inhabited-R : R
  inhabited-R = _

data ⊥ : Set where

record R where
  field absurd : ⊥

boom : ⊥
boom = R.absurd M.inhabited-R


-- Andreas, 2017-07-28, issue #1126 reported by Saizan is fixed

data ℕ : Set where
  zero : ℕ
  suc  : (n : ℕ) → ℕ
{-# BUILTIN NATURAL ℕ #-}

data Unit : Set where
  unit : Unit

slow : ℕ → Unit
slow zero = unit
slow (suc n) = slow n

postulate
  IO : Set → Set
{-# COMPILE GHC IO = type IO #-}
{-# BUILTIN IO IO #-}

postulate
  return  : ∀ {A} → A → IO A
{-# COMPILE GHC return = (\ _ -> return) #-}
{-# COMPILE JS return =
    function(u0) { return function(u1) { return function(x) { return function(cb) { cb(x); }; }; }; } #-}

{-# FOREIGN OCaml
  let return _ x world = Lwt.return x
#-}
{-# COMPILE OCaml return = return #-}

force : Unit → IO Unit
force unit = return unit

n = 3000000000

main : IO Unit
main = force (slow n)

-- Should terminate instantaneously.


module Issue22 where

postulate
  D   : Set
  _≡_ : D → D → Set
  d e : D

foo : ∀ x → x ≡ x
foo x = bar
  where
  postulate
    d≡e : d ≡ e

  postulate
    bar : x ≡ x
  {-# ATP prove bar d≡e #-}

-- $ apia Bug.agda
-- An internal error has occurred. Please report this as a bug.
-- Location of the error: src/Apia/Utils/AgdaAPI/Interface.hs:307

-- The error occurs because the dead code analysis removes `d≡e` from
-- the the interfase file.


module io-test2 where

open import io
open import list
open import string
open import unit

main : IO ⊤
main = getArgs >>= cont
          where cont : 𝕃 string → IO ⊤
                cont [] = return triv
                cont (x :: xs) = (readFiniteFile x) >>= putStr