Source code on Github
{-# OPTIONS --safe #-}
module Prelude.Measurable where

open import Induction
open import Induction.WellFounded
open import Data.Nat.Induction
import Relation.Binary.Construct.On as On

open import Prelude.Init; open SetAsType
open Nat
open import Prelude.General
open import Prelude.DecEq.Core

record Measurable {} (A : Type ) : Type  where
  field
    ∣_∣ : A  

open Measurable ⦃...⦄ public

private
  variable
    a b : Level
    A : Type a
    B : Type b

instance
  Measurable-ℕ : Measurable 
  Measurable-ℕ .∣_∣ x = x

  Measurable-⊎ :  _ : Measurable A   _ : Measurable B   Measurable (A  B)
  Measurable-⊎ .∣_∣ (inj₁ x) =  x 
  Measurable-⊎ .∣_∣ (inj₂ x) =  x 


∃Measurable : Type₁
∃Measurable = Σ[ A  Type ] (Measurable A) × A

toMeasure :  {A : Type}  _ : Measurable A   A  ∃Measurable
toMeasure  mx  x = _ , mx , x

-- NB: this can be used when you want a *heterogeneous* well-founded relation
instance
  Measurable∃ : Measurable ∃Measurable
  Measurable∃ .∣_∣ (_ , record {∣_∣ = f} , x) = f x

module _  _ : Measurable A  where

  _≺_ : Rel A 0ℓ
  _≺_ = _<_ on ∣_∣

  ≺-wf : WellFounded _≺_
  ≺-wf = On.wellFounded ∣_∣ <-wellFounded

  ≺-rec : Recursor (WfRec _≺_)
  ≺-rec = All.wfRec ≺-wf 0ℓ

_≺ᵐ_ :  {A B : Type}  _ : Measurable A   _ : Measurable B   A  B  Type
x ≺ᵐ y = toMeasure x  toMeasure y

-- alternatives for products
Measurable-×ˡ :  _ : Measurable A   Measurable (A × B)
Measurable-×ˡ .∣_∣ (x , _) =  x 

Measurable-×ʳ :  _ : Measurable B   Measurable (A × B)
Measurable-×ʳ .∣_∣ (_ , x) =  x 

-- alternatives for lists
Measurable-List₀ : Measurable (List A)
Measurable-List₀ .∣_∣ = length

Measurable-List₁ :  _ : Measurable A   Measurable (List A)
Measurable-List₁ {A = A} .∣_∣ = go
  where
    go : List A  
    go [] = 1
    go (x  xs) =  x  + go xs