Open Type Level Proofs in Haskell/Idris

Question

In Idris/Haskell, one can prove properties of data by annotating the types and using GADT constructors, such as with Vect, however, this requires hardcoding the property into th

Answer 1

I believe that McBride has answered that question (for Type Theory) in his ornament paper (pdf). The concept you are looking for is the one of an algebraic ornament (emphasis mine):

An algebra φ describes a structural method to interpret data, giving rise to a fold φ oper- ation, applying the method recursively. Unsurprisingly, the resulting tree of calls to φ has the same structure as the original data — that is the point, after all. But what if that were, before all, the point? Suppose we wanted to fix the result of fold φ in advance, representing only those data which would deliver the answer we wanted. We should need the data to fit with a tree of φ calls which delivers that answer. Can we restrict our data to exactly that? Of course we can, if we index by the answer.

Now, let's write some code. I've put the whole thing in a gist because I'm going to interleave comments in here. Also, I'm using Agda but it should be easy to tranlate to Idris.

module reornament where

We start by defining what it means to be an algebra delivering Bs acting on a list of As. We need a base case (a value of type B) as well as way to combine the head of the list with the induction hypothesis.

ListAlg : (A B : Set) → Set
ListAlg A B = B × (A → B → B)

Given this definition, we can define a type of lists of As indexed by Bs whose value is precisely the result of the computation corresponding to a given ListAlg A B. In the nil case, the result is the base case provided to us by the algebra (proj₁ alg) whilst in the cons case, we simply combine the induction hypothesis with the new head using the second projection:

data ListSpec (A : Set) {B : Set} (alg : ListAlg A B) : (b : B) → Set where
  nil  :  ListSpec A alg (proj₁ alg)
  cons : (a : A) {b : B} (as : ListSpec A alg b) → ListSpec A alg (proj₂ alg a b)

Ok, let's import some libraries and see a couple of examples now:

open import Data.Product
open import Data.Nat
open import Data.List

The algebra computing the length of a list is given by 0 as the base case and const suc as the way to combine an A and the length of the tail to build the length of the current list. Hence:

AlgLength : {A : Set} → ListAlg A ℕ
AlgLength = 0 , (λ _ → suc)

If the elements are natural numbers then they can be summed. The algebra corresponding to that has 0 as the base case and _+_ as the way to combine an ℕ together with the sum of the elements contained in the tail. Hence:

AlgSum : ListAlg ℕ ℕ
AlgSum = 0 , _+_

Crazy thought: If we have two algebras working on the same elements, we can combine them! This way we'll track 2 invariants rather than one!

Alg× : {A B C : Set} (algB : ListAlg A B) (algC : ListAlg A C) →
       ListAlg A (B × C)
Alg× (b , sucB) (c , sucC) = (b , c) , (λ a → λ { (b , c) → sucB a b , sucC a c })

An now the examples:

If we are tracking the length, then we can define Vectors:

Vec : (A : Set) (n : ℕ) → Set
Vec A n = ListSpec A AlgLength n

And have, e.g., this vector of length 4:

allFin4 : Vec ℕ 4
allFin4 = cons 0 (cons 1 (cons 2 (cons 3 nil)))

If we are tracking the sum of the elements, then we can define a notion of distribution: a statistical distribution is a list of probabilities whose sum is 100:

Distribution : Set
Distribution = ListSpec ℕ AlgSum 100

And we can define a uniform one for instance:

uniform : Distribution
uniform = cons 25 (cons 25 (cons 25 (cons 25 nil)))

Finally, by combining the length and sum algebras, we can implement the notion of sized distribution.

SizedDistribution : ℕ → Set
SizedDistribution n = ListSpec ℕ (Alg× AlgLength AlgSum) (n , 100)

And give this nice uniform distribution for a 4 elements set:

uniform4 : SizedDistribution 4
uniform4 = cons 25 (cons 25 (cons 25 (cons 25 nil)))