How to define a pair type in Idris that only holds certain combinations of values

I'm trying to learn about dependent types in Idris by attempting something way out of my depth. Please bear with me if I make any silly mistakes.

Given the simple type

data Letter = A | B | C | D

I would like to define a type LPair that holds a pair of Letter such that only "neighboring" letters can be paired. For example, B can be paired with A or C, but not D or itself. It wraps around, so A and D are treated as neighbors.

In practice, given x : Letter and y : Letter, mklpair x y would be equivalent to mklpair y x, but I'm not sure if that property can or should be reflected in the type.

What is the best way to go about making such a type?

Solution

The most straightforward way is to create a subset of (Letter, Letter) which elements fulfill the predicate (a, b : Letter) -> Either (Next a b) (Next b a), where Next is are just the neighbors to the right:

data Letter = A | B | C | D

data Next : Letter -> Letter -> Type where
  AB : Next A B
  BC : Next B C
  CD : Next C D
  DA : Next D A

Neighbour : Letter -> Letter -> Type
Neighbour a b = Either (Next a b) (Next b a)

LPair : Type
LPair = (p : (Letter, Letter) ** Neighbour (fst p) (snd p))

mklpair : (a : Letter) -> (b : Letter) -> {auto prf : Neighbour a b} -> LPair
mklpair a b {prf} = ((a, b) ** prf)

N.B.: This approach is nice and simple, but once you implement a function that decides if a and b are next to each other, you'll need around (number of letters)^3 cases:

isNext : (a : Letter) -> (b : Letter) -> Dec (Next a b)
isNext A A = No nAA where
  nAA : Next A A -> Void
  nAA AB impossible
  nAA BC impossible
  nAA CD impossible
  nAA DA impossible
isNext A B = Yes AB
...

If you have a lot of letters and need a decision function, the usual approach is thus to map your data to a recursive type like Nat. Because of your modulo case (Next D A), you'd need a wrapper like:

data NextN : Nat -> Nat -> Nat -> Type where
  NextS : {auto prf :      (S a) `LTE` m}  -> NextN m a (S a) -- succ in mod m
  NextZ : {auto prf : Not ((S a) `LTE` m)} -> NextN m a Z     -- wrap around

LToN : Letter -> Nat
LToN A = 0
LToN B = 1
LToN C = 2
LToN D = 3

LNeighbour : Letter -> Letter -> Type
LNeighbour x y =
  let a = LToN x
      b = LToN y
  in Either (NextN 3 a b) (NextN 3 b a)

LNPair : Type
LNPair = (p : (Letter, Letter) ** LNeighbour (fst p) (snd p))

mklnpair : (a : Letter) -> (b : Letter) -> {auto prf : LNeighbour a b} -> LNPair
mklnpair a b {prf} = ((a, b) ** prf)

With NextS and NextZ you only have two cases you need to inspect instead one for each letter.