From 5bc6398977e03adb7b861fceaf7c4bf4b06160ca Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Wed, 24 Aug 2022 15:49:57 +1000
Subject: [PATCH 01/47] =?UTF-8?q?Add=20some=20sketches=20of=20Fathom?=
 =?UTF-8?q?=E2=80=99s=20core=20in=20Idris=202?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 .github/workflows/ci.yml                      |  12 +-
 experiments/README.md                         |   1 +
 experiments/idris/.gitignore                  |   1 +
 experiments/idris/README.md                   |   8 +
 experiments/idris/fathom.ipkg                 |  48 +++++
 experiments/idris/src/Fathom.idr              |   1 +
 experiments/idris/src/Fathom/Base.idr         | 107 +++++++++++
 .../src/Fathom/Closed/IndexedInductive.idr    |  82 ++++++++
 .../src/Fathom/Closed/InductiveRecursive.idr  | 179 ++++++++++++++++++
 experiments/idris/src/Fathom/Open/Record.idr  | 120 ++++++++++++
 experiments/idris/src/Playground.idr          | 119 ++++++++++++
 flake.nix                                     |  69 +++++--
 12 files changed, 724 insertions(+), 23 deletions(-)
 create mode 100644 experiments/idris/.gitignore
 create mode 100644 experiments/idris/README.md
 create mode 100644 experiments/idris/fathom.ipkg
 create mode 100644 experiments/idris/src/Fathom.idr
 create mode 100644 experiments/idris/src/Fathom/Base.idr
 create mode 100644 experiments/idris/src/Fathom/Closed/IndexedInductive.idr
 create mode 100644 experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
 create mode 100644 experiments/idris/src/Fathom/Open/Record.idr
 create mode 100644 experiments/idris/src/Playground.idr

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 2c4e01bc2..a2149c21c 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -23,11 +23,11 @@ jobs:
         uses: cachix/install-nix-action@v17
 
       - name: cargo check
-        run: nix develop .#${{ matrix.rust-toolchain }} --command cargo check
+        run: nix develop .#rust-${{ matrix.rust-toolchain }} --command cargo check
       - name: cargo build
-        run: nix develop .#${{ matrix.rust-toolchain }} --command cargo build
+        run: nix develop .#rust-${{ matrix.rust-toolchain }} --command cargo build
       - name: cargo test
-        run: nix develop .#${{ matrix.rust-toolchain }} --command cargo test
+        run: nix develop .#rust-${{ matrix.rust-toolchain }} --command cargo test
 
   cargo-fmt:
     runs-on: ubuntu-latest
@@ -42,7 +42,7 @@ jobs:
         uses: cachix/install-nix-action@v17
 
       - name: Run cargo fmt
-        run: nix develop .#${{ matrix.rust-toolchain }} --command cargo fmt
+        run: nix develop .#rust-${{ matrix.rust-toolchain }} --command cargo fmt
 
   cargo-clippy:
     runs-on: ubuntu-latest
@@ -62,7 +62,7 @@ jobs:
         run: rm --recursive --force --verbose ~/.cargo/bin
 
       - name: Run cargo clippy
-        run: nix develop .#${{ matrix.rust-toolchain }} --command cargo clippy -- --deny warnings
+        run: nix develop .#rust-${{ matrix.rust-toolchain }} --command cargo clippy -- --deny warnings
 
   nixpkgs-fmt:
     runs-on: ubuntu-latest
@@ -74,4 +74,4 @@ jobs:
         uses: cachix/install-nix-action@v17
 
       - name: Run nixpkgs-fmt
-        run: nix develop --command nixpkgs-fmt --check .
+        run: nix develop .#nix --command nixpkgs-fmt --check .
diff --git a/experiments/README.md b/experiments/README.md
index c15ca3101..75058e3d0 100644
--- a/experiments/README.md
+++ b/experiments/README.md
@@ -13,6 +13,7 @@ In rough chronological order:
 5. [rust-prototype-v2](./rust-prototype-v2) (@brendanzab)
 6. [makam-spec](./makam-spec) (@brendanzab)
 7. [rust-prototype-v3](./rust-prototype-v3) (@brendanzab)
+8. [idris](./idris) (@brendanzab)
 
 The following repositories also provided us with valuable experience along the way:
 
diff --git a/experiments/idris/.gitignore b/experiments/idris/.gitignore
new file mode 100644
index 000000000..378eac25d
--- /dev/null
+++ b/experiments/idris/.gitignore
@@ -0,0 +1 @@
+build
diff --git a/experiments/idris/README.md b/experiments/idris/README.md
new file mode 100644
index 000000000..01f35f0cf
--- /dev/null
+++ b/experiments/idris/README.md
@@ -0,0 +1,8 @@
+# Core language experiments in Idris 2
+
+Some sketches of Fathom’s core language using Idris as a logical framework.
+
+```command
+$ idris2 --repl experiments/idris/fathom.ipkg
+Main> :load "src/Playground.idr"
+```
diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
new file mode 100644
index 000000000..250c95184
--- /dev/null
+++ b/experiments/idris/fathom.ipkg
@@ -0,0 +1,48 @@
+package fathom
+-- version =
+-- authors =
+-- maintainers =
+-- license =
+-- brief =
+-- readme =
+-- homepage =
+-- sourceloc =
+-- bugtracker =
+
+-- packages to add to search path
+-- depends =
+
+-- modules to install
+modules = Fathom
+        , Fathom.Base
+        , Fathom.Closed.InductiveRecursive
+        , Fathom.Closed.IndexedInductive
+        , Fathom.Open.Record
+
+-- main file (i.e. file to load at REPL)
+-- main =
+
+-- name of executable
+-- executable =
+-- opts =
+sourcedir = "src"
+builddir = "build"
+outputdir = "build/exec"
+
+-- script to run before building
+-- prebuild =
+
+-- script to run after building
+-- postbuild =
+
+-- script to run after building, before installing
+-- preinstall =
+
+-- script to run after installing
+-- postinstall =
+
+-- script to run before cleaning
+-- preclean =
+
+-- script to run after cleaning
+-- postclean =
diff --git a/experiments/idris/src/Fathom.idr b/experiments/idris/src/Fathom.idr
new file mode 100644
index 000000000..00781a8d2
--- /dev/null
+++ b/experiments/idris/src/Fathom.idr
@@ -0,0 +1 @@
+||| A sketch of core Fathom in Idris 2
diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
new file mode 100644
index 000000000..ee5001008
--- /dev/null
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -0,0 +1,107 @@
+module Fathom.Base
+
+
+import Data.Colist
+import Data.List
+
+
+------------------
+-- USEFUL TYPES --
+------------------
+
+
+||| A value that is refined by a proposition.
+|||
+||| This is a bit like `(x : A ** B)`, but with the second element erased.
+public export
+record Refine (0 A : Type) (0 P : A -> Type) where
+  constructor MkRefine
+  ||| The wrapped value
+  value : A
+  ||| The proof of the proposition
+  0 prf : P value
+
+||| Refine a value with a proposition
+public export
+refine : {0 A : Type} -> {0 P : A -> Type} -> (value : A) -> {auto 0 prf : P value} -> Refine A P
+refine value {prf} = MkRefine { value, prf }
+
+
+||| Singleton types
+|||
+||| Inspired by [this type](https://agda.readthedocs.io/en/v2.5.4.1/language/with-abstraction.html#the-inspect-idiom)
+||| from the Agda docs.
+public export
+data Sing : {0 A : Type} -> (x : A) -> Type where
+  MkSing : {0 A : Type} -> {0 x : A} -> (y : A) -> {auto prf : x = y} -> Sing x
+
+||| Convert a singleton back to its underlying value
+public export
+value : {0 Val : Type} -> {0 x : Val} -> Sing x -> Val
+value (MkSing y) = y
+
+
+---------------------------
+-- ENCODER/DECODER PAIRS --
+---------------------------
+
+-- Inspiration taken from Narcissus:
+--
+-- * [Narcissus: Correct-by-Construction Derivation of Decoders and Encoders from Binary Formats](https://dl.acm.org/doi/10.1145/3341686)
+--   by Delaware et. al.
+-- * [`Narcissus/Common/Specs.v`](https://github.com/mit-plv/fiat/blob/master/src/Narcissus/Common/Specs.v)
+--
+-- TODO: Add support for [Narcissus-style stores](https://github.com/mit-plv/fiat/tree/master/src/Narcissus/Stores)
+
+parameters (Source : Type, Target : Type)
+
+  ||| Decoders consume a _target value_ and produce either:
+  |||
+  ||| - a _source value_ and _remaining target value_
+  ||| - or nothing if in error occurred
+  |||
+  ||| @ Source  The type of source values (usually an in-memory data structure)
+  ||| @ Target  The type of target values (usually a byte-stream)
+  public export
+  Decode : Type
+  Decode = Target -> Maybe (Source, Target)
+
+  ||| Encoders take a _source value_ and _remaining target value_ and produce either:
+  |||
+  ||| - an _updated target value_
+  ||| - or nothing if in error occurred
+  |||
+  ||| @ Source  The type of source values (usually an in-memory data structure)
+  ||| @ Target  The type of target values (usually a byte-stream)
+  public export
+  Encode : Type
+  Encode = Source -> Target -> Maybe Target
+
+
+----------------------
+-- ENCODING TARGETS --
+----------------------
+
+
+||| A possibly infinite stream of bits
+public export
+BitStream : Type
+BitStream = Colist Bool
+
+
+||| A possibly infinite stream of bytes
+public export
+ByteStream : Type
+ByteStream = Colist Bits8
+
+
+||| A finite bit buffer
+public export
+BitBuffer : Type
+BitBuffer = List Bool
+
+
+||| A finite byte buffer
+public export
+ByteBuffer : Type
+ByteBuffer = List Bits8
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
new file mode 100644
index 000000000..4a0e01e15
--- /dev/null
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -0,0 +1,82 @@
+||| A closed universe of format descriptions as an inductive type, where the
+||| in-memory representation is tracked as an index on the type.
+
+module Fathom.Closed.IndexedInductive
+
+
+import Data.Colist
+import Data.Vect
+
+import Fathom.Base
+
+
+-------------------------
+-- FORMAT DESCRIPTIONS --
+-------------------------
+
+
+||| Universe of format descriptions indexed by their machine representations
+public export
+data FormatOf : (0 Rep : Type) -> Type where
+  End : FormatOf Unit
+  Fail : FormatOf Void
+  Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
+  Skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
+  Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+
+
+
+---------------------------
+-- ENCODER/DECODER PAIRS --
+---------------------------
+
+export
+decode : {0 Rep : Type} -> (f : FormatOf Rep) -> Decode Rep (Colist a)
+decode End [] = Just ((), [])
+decode End (_::_) = Nothing
+decode Fail _ = Nothing
+decode (Pure x) buffer =
+  Just (MkSing x, buffer)
+decode (Skip f _) buffer = do
+  (x, buffer') <- decode f buffer
+  Just ((), buffer')
+decode (Repeat 0 f) buffer =
+  Just ([], buffer)
+decode (Repeat (S len) f) buffer = do
+  (x, buffer') <- decode f buffer
+  (xs, buffer'') <- decode (Repeat len f) buffer'
+  Just (x :: xs, buffer'')
+decode (Bind f1 f2) buffer = do
+  (x, buffer') <- decode f1 buffer
+  (y, buffer'') <- decode (f2 x) buffer'
+  Just ((x ** y), buffer'')
+
+
+export
+encode : {0 Rep : Type} -> (f : FormatOf Rep) -> Encode Rep (Colist a)
+encode End () _ = Just []
+encode (Pure x) (MkSing _) buffer = Just buffer
+encode (Skip f def) () buffer = do
+  encode f def buffer
+encode (Repeat Z f) [] buffer = Just buffer
+encode (Repeat (S len) f) (x :: xs) buffer = do
+  buffer' <- encode (Repeat len f) xs buffer
+  encode f x buffer'
+encode (Bind f1 f2) (x ** y) buffer = do
+  buffer' <- encode (f2 x) y buffer
+  encode f1 x buffer'
+
+
+-----------------
+-- EXPERIMENTS --
+-----------------
+
+
+either : (cond : Bool) -> FormatOf a -> FormatOf b -> FormatOf (if cond then a else b)
+either True f1 _ = f1
+either False _ f2 = f2
+
+orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
+orPure True f _ = f
+orPure False _ def = Pure def
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
new file mode 100644
index 000000000..def23d60c
--- /dev/null
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -0,0 +1,179 @@
+||| A closed universe of format descriptions, using induction recursion between
+||| the descriptions and their in-memory representation. This closely matches
+||| the current implementation of format descriptions in Fathom.
+|||
+||| [Induction recusion](https://en.wikipedia.org/wiki/Induction-recursion) is
+||| where an inductive datatype is defined simultaneously with a function that
+||| operates on that type (see the @Format and @Rep definitions below).
+|||
+||| The universe is ‘closed’ in the sense tha new format descriptions cannot be
+||| added to the type theory, although they can be composed out of other formats)
+|||
+||| This is similar to the approach used when defining type theories with
+||| Tarski-style universes. In-fact inductive-recusrive datatypes as a language
+||| feature were apparently originally motivated by this use case (see: [“A
+||| General Formulation of Simultaneous Inductive-Recursive Definitions in Type
+||| Theory”](https://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.6.4575) by
+||| Dybjer).
+|||
+||| Inspiration for this approach is taken from [“The Power of Pi”](https://cs.ru.nl/~wouters/Publications/ThePowerOfPi.pdf)
+||| by Oury and Swierstra.
+
+module Fathom.Closed.InductiveRecursive
+
+
+import Data.Colist
+import Data.Vect
+
+import Fathom.Base
+
+-- import Fathom.Open.Record
+
+
+-------------------------
+-- FORMAT DESCRIPTIONS --
+-------------------------
+
+
+mutual
+  ||| Universe of format descriptions
+  public export
+  data Format : Type where
+    End : Format
+    Fail : Format
+    Pure : {0 A : Type} -> A -> Format
+    Skip : (f : Format) -> (def : Rep f) -> Format
+    Repeat : Nat -> Format -> Format
+    Bind : (f : Format) -> (Rep f -> Format) -> Format
+
+    -- Questionable format descriptions
+    -- OrPure : (cond : Bool) -> (f : Format) -> (def : Rep f) -> Format
+    -- OfSing : (f : Format) -> Sing (Rep f) -> Format
+    -- OfEq : (f : Format) -> (r : Type) -> {auto 0 prf : Rep f = r} -> Format
+
+    -- Broken stuff
+    -- Let : (f : Format) -> (Rep f -> Format) -> Format
+    -- Custom : (f : Record.Format) -> Format
+
+
+  ||| In-memory representation of format descriptions
+  public export
+  Rep : Format -> Type
+  Rep End = Unit
+  Rep Fail = Void
+  Rep (Skip _ _) = Unit
+  Rep (Repeat len f) = Vect len (Rep f)
+  Rep (Pure x) = Sing x
+  Rep (Bind f1 f2) = (x : Rep f1 ** Rep (f2 x))
+
+  -- Questionable format descriptions
+  -- Rep (OrPure _ f _) = Rep f
+  -- Rep (OfSing f r) = value r
+  -- Rep (OfEq f r) = r
+
+  -- Broken stuff
+  -- Rep (Let f1 f2) = Rep (f2 ?halp)
+  -- Rep (Custom f) = f.Rep
+
+
+---------------------------
+-- ENCODER/DECODER PAIRS --
+---------------------------
+
+
+export
+decode : (f : Format) -> Decode (Rep f) (Colist a)
+decode End [] = Just ((), [])
+decode End (_::_) = Nothing
+decode Fail _ = Nothing
+decode (Pure x) buffer =
+  Just (MkSing x, buffer)
+decode (Skip f _) buffer = do
+  (x, buffer') <- decode f buffer
+  Just ((), buffer')
+decode (Repeat 0 f) buffer =
+  Just ([], buffer)
+decode (Repeat (S len) f) buffer = do
+  (x, buffer') <- decode f buffer
+  (xs, buffer'') <- decode (Repeat len f) buffer'
+  Just (x :: xs, buffer'')
+decode (Bind f1 f2) buffer = do
+  (x, buffer') <- decode f1 buffer
+  (y, buffer'') <- decode (f2 x) buffer'
+  Just ((x ** y), buffer'')
+
+-- Questionable format descriptions
+-- decode (OrPure True f _) buffer = decode f buffer
+-- decode (OrPure False _ def) buffer = Just (def, buffer)
+-- decode (OfSing f (MkSing r {prf})) buffer = do
+--   (x, buffer') <- decode f buffer
+--   Just (rewrite sym prf in x, buffer')
+-- decode (OfEq f _ {prf}) buffer = do
+--   (x, buffer') <- decode f buffer
+--   Just (rewrite sym prf in x, buffer')
+
+-- Broken stuff
+
+
+export
+encode : (f : Format) -> Encode (Rep f) (Colist a)
+encode End () _ = Just []
+encode (Pure x) (MkSing _) buffer = Just buffer
+encode (Skip f def) () buffer = do
+  encode f def buffer
+encode (Repeat Z f) [] buffer = Just buffer
+encode (Repeat (S len) f) (x :: xs) buffer = do
+  buffer' <- encode (Repeat len f) xs buffer
+  encode f x buffer'
+encode (Bind f1 f2) (x ** y) buffer = do
+  buffer' <- encode (f2 x) y buffer
+  encode f1 x buffer'
+-- Questionable format descriptions
+-- encode (OrPure True f _) x buffer = encode f x buffer
+-- encode (OrPure False _ def) x buffer = Just buffer
+-- encode (OfSing f r) x buffer = do
+--   buffer' <- encode f ?todo_x buffer
+--   ?todo_encode
+-- encode (OfEq f _ {prf}) x buffer = do
+--   encode f (rewrite prf in x) buffer
+
+
+-----------------
+-- EXPERIMENTS --
+-----------------
+
+
+||| A format description refined with a fixed representation
+public export
+FormatOf : (0 Rep : Type) -> Type
+FormatOf rep = Refine Format (\f => Rep f = rep)
+
+
+toFormatOf : (f : Format) -> FormatOf (Rep f)
+toFormatOf f = refine f
+
+
+export
+either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
+either True f1 _ = refine f1
+either False _ f2 = refine f2
+
+
+export
+orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
+orPure True f _ = f
+orPure False _ def = refine (Pure def)
+
+
+export
+orPure' : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
+orPure' True f _ = f
+orPure' False _ def = refine (Pure def)
+
+
+foo : (cond : Bool) -> (f : Format) -> Rep f -> Format
+foo cond f def = case orPure cond (toFormatOf f) def of
+  MkRefine f' prf =>
+    Bind f' (\x => case cond of
+      True => ?todo1
+      False => ?todo2)
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
new file mode 100644
index 000000000..3bcdada6f
--- /dev/null
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -0,0 +1,120 @@
+||| Open format universe
+|||
+||| This module defines an open universe of binary format descriptions using
+||| records to define an inderface. By defining formats in this way, the
+||| universe of formats is open to extension.
+|||
+||| I’m not sure, but this reminds me a little of the ‘coinductive universes’
+||| that [some type theorists were proposing for HoTT](https://www.cmu.edu/dietrich/philosophy/hott/slides/shulman-2022-05-12.pdf#page=79),
+||| but I may be mistaken.
+
+module Fathom.Open.Record
+
+
+import Data.Colist
+import Data.Vect
+
+import Fathom.Base
+
+
+public export
+record Format where
+  constructor MkFormat
+  Rep : Type
+  decode : Decode Rep BitStream
+  encode : Encode Rep BitStream
+
+
+public export
+end : Format
+end = MkFormat { Rep, decode, encode } where
+  Rep : Type
+  Rep = Unit
+
+  decode : Decode Rep BitStream
+  decode [] = Just ((), [])
+  decode (_::_) = Nothing
+
+  encode : Encode Rep BitStream
+  encode () _ = Just []
+
+public export
+fail : Format
+fail = MkFormat { Rep, decode, encode } where
+  Rep : Type
+  Rep = Void
+
+  decode : Decode Rep BitStream
+  decode _ = Nothing
+
+  encode : Encode Rep BitStream
+  encode x = void x
+
+public export
+pure : {0 A : Type} -> A -> Format
+pure x = MkFormat { Rep, decode, encode } where
+  Rep : Type
+  Rep = Sing x
+
+  decode : Decode Rep BitStream
+  decode buffer = Just (MkSing x, buffer)
+
+  encode : Encode Rep BitStream
+  encode (MkSing _) buffer = Just buffer
+
+public export
+skip : (f : Format) -> (def : f.Rep) -> Format
+skip f def = MkFormat { Rep, decode, encode } where
+  Rep : Type
+  Rep = ()
+
+  decode : Decode Rep BitStream
+  decode buffer = do
+    (x, buffer') <- f.decode buffer
+    Just ((), buffer')
+
+  encode : Encode Rep BitStream
+  encode () buffer = do
+    f.encode def buffer
+
+
+public export
+repeat : Nat -> Format -> Format
+repeat len f = MkFormat { Rep, decode, encode } where
+  Rep : Type
+  Rep = Vect len f.Rep
+
+  decode : Decode Rep BitStream
+  decode = go len where
+    go : (len : Nat) -> Decode (Vect len f.Rep) BitStream
+    go 0 buffer = Just ([], buffer)
+    go (S len) buffer = do
+      (x, buffer') <- f.decode buffer
+      (xs, buffer'') <- go len buffer'
+      Just (x :: xs, buffer'')
+
+  encode : Encode Rep BitStream
+  encode = go len where
+    go : (len : Nat) -> Encode (Vect len f.Rep) BitStream
+    go 0 [] buffer = Just buffer
+    go (S len) (x :: xs) buffer = do
+      buffer' <- go len xs buffer
+      f.encode x buffer'
+
+
+public export
+bind : (f : Format) -> (f.Rep -> Format) -> Format
+bind f1 f2 = MkFormat { Rep, decode, encode } where
+  Rep : Type
+  Rep = (x : f1.Rep ** (f2 x).Rep)
+
+  decode : Decode Rep BitStream
+  decode buffer = do
+    (x, buffer') <- f1.decode buffer
+    (y, buffer'') <- (f2 x).decode buffer'
+    Just ((x ** y), buffer'')
+
+  encode : Encode Rep BitStream
+  encode (x ** y) buffer = do
+    buffer' <- (f2 x).encode y buffer
+    f1.encode x buffer'
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
new file mode 100644
index 000000000..f60b1274c
--- /dev/null
+++ b/experiments/idris/src/Playground.idr
@@ -0,0 +1,119 @@
+module Playground
+
+
+import Data.Colist
+import Data.Vect
+
+import Fathom.Base
+import Fathom.Closed.InductiveRecursive as IndRec
+import Fathom.Closed.IndexedInductive as Indexed
+import Fathom.Open.Record as Record
+
+
+-- Experiment with converting between the different styles of format universes
+
+
+||| Convert an inductive-recusive format universe into a record format
+public export
+format : IndRec.Format -> Record.Format
+format f = Record.MkFormat
+  { Rep = IndRec.Rep f
+  , decode = IndRec.decode f
+  , encode = IndRec.encode f
+  }
+
+
+||| Conver an indexed-inductive format universe into a record format
+public export
+formatOf : {Rep : Type} -> Indexed.FormatOf Rep -> Record.Format
+formatOf f = Record.MkFormat
+  { Rep = Rep
+  , decode = Indexed.decode f
+  , encode = Indexed.encode f
+  }
+
+
+-- public export
+-- format' : IndRec.Format -> Record.Format
+-- format' f = MkFormat { Rep, decode, encode } where
+--   Rep : Type
+--   Rep = IndRec.Rep f
+
+--   decode : Decode (IndRec.Rep f) BitStream
+--   decode = case f of
+--     End => end.decode
+--     Fail => fail.decode
+--     Pure x => (pure x).decode
+--     Skip f def => (skip (format' f) def).decode
+--     Repeat len f => (repeat len (format' f)).decode
+--     Bind f1 f2 => (bind (format' f1) (\x => format' (f2 x))).decode
+--     OfSing f r => (format' f).decode
+--     OfEq f r => (format' f).decode
+
+--   encode : Encode Rep BitStream
+--   encode = case f of
+--     End => end.encode
+--     Fail => fail.encode
+--     Pure x => (pure x).encode
+--     Skip f def => (skip (format' f) def).encode
+--     Repeat len f => (repeat len (format' f)).encode
+--     Bind f1 f2 => (bind (format' f1) (\x => format' (f2 x))).encode
+--     OfSing f r => (format' f).encode
+--     OfEq f r => (format' f).encode
+
+
+||| Convert an inductive-recursive format description to an indexed format
+indRecToIndexed : (f : IndRec.Format) -> Indexed.FormatOf (Rep f)
+indRecToIndexed End = Indexed.End
+indRecToIndexed Fail = Indexed.Fail
+indRecToIndexed (Pure x) = Indexed.Pure x
+indRecToIndexed (Skip f def) = Indexed.Skip (indRecToIndexed f) def
+indRecToIndexed (Repeat len f) = Indexed.Repeat len (indRecToIndexed f)
+indRecToIndexed (Bind f g) = Indexed.Bind (indRecToIndexed f) (\x => indRecToIndexed (g x))
+-- indRecToIndexed (OfSing f (MkSing _ {prf})) = rewrite sym prf in indRecToIndexed f
+-- indRecToIndexed (OfEq f _ {prf}) = rewrite sym prf in indRecToIndexed f
+
+
+-- ||| Convert an indexed format description to an inductive-recursive format
+-- indexedToIndRec : {0 Rep : Type} -> (f : Indexed.FormatOf Rep) -> IndRec.FormatOf Rep
+-- indexedToIndRec End = MkRefine { value = IndRec.End, prf = Refl }
+-- indexedToIndRec Fail = MkRefine { value = IndRec.Fail, prf = Refl }
+-- indexedToIndRec (Pure x) = MkRefine { value = IndRec.Pure x, prf = Refl }
+-- indexedToIndRec (Skip {a} f def) =
+--   let
+--     MkRefine f' prf = indexedToIndRec f
+--     symPrf = sym prf
+--     def' = rewrite prf in def
+--   in
+--     MkRefine { value = IndRec.Skip f' ?todoDef, prf = ?todoSkip }
+-- indexedToIndRec (Repeat len f) = MkRefine { value = IndRec.Repeat _ _, prf = ?todoRepeat }
+-- indexedToIndRec (Bind f g) = MkRefine { value = IndRec.Bind _ _, prf = ?todoBind }
+
+||| Convert an indexed format description to an inductive-recursive format
+indexedToIndRec : {0 Rep : Type} -> (f : Indexed.FormatOf Rep) -> IndRec.Format
+indexedToIndRec End = IndRec.End
+indexedToIndRec Fail = IndRec.Fail
+indexedToIndRec (Pure x) = IndRec.Pure x
+indexedToIndRec (Skip f def) =
+  IndRec.Skip (indexedToIndRec f) ?todo_def
+--                                ^^^^^^^^^
+-- Error: While processing right hand side of indexedToIndRec. Can't solve constraint between: a and Rep (indexedToIndRec f).
+--
+--    def : a
+--    f : FormatOf a
+--  0 Rep : Type
+-- ------------------------------
+-- todo_def : Rep (indexedToIndRec f)
+--
+indexedToIndRec (Repeat len f) = IndRec.Repeat len (indexedToIndRec f)
+indexedToIndRec (Bind f1 f2) = IndRec.Bind (indexedToIndRec f1) (\x => indexedToIndRec ?todo_f2)
+--                                                                                     ^^^^^^^^
+-- Error: While processing right hand side of indexedToIndRec. Can't solve constraint
+-- between: Rep (indexedToIndRec f1) and a (implicitly bound at Fathom.Test:86:1--86:95).
+--
+--    f2 : (x : a) -> FormatOf (b x)
+--    f1 : FormatOf a
+--  0 Rep : Type
+--    x : Rep (indexedToIndRec f1)
+-- ------------------------------
+-- todo_f2 : FormatOf ?Rep
diff --git a/flake.nix b/flake.nix
index 4c996f3d6..a5de25824 100644
--- a/flake.nix
+++ b/flake.nix
@@ -74,19 +74,53 @@
         # If you want to live on the bleeding edge, you could also try using the
         # nightly shell with the following `.envrc` file:
         #
-        #    use flake .#nightly
+        #    use flake .#rust-nightly
         #
         # If you choose to use Direnv, note that `.envrc` should be added to
         # your local git excludes, or added to to your global gitignore.
         devShells = {
-          # Use the stable toolchain by default for development, to get the
-          # latest diagnostics and compiler improvements.
+          # Default development shell
           #
           #    $ nix develop
           #    $ nix develop --command cargo check
           #
-          default = self.devShells.${system}.stable;
+          default =
+            let
+              systemShells = self.devShells.${system};
+            in
+            pkgs.mkShell {
+              inputsFrom = [
+                # Use the stable toolchain by default for development to get the
+                # latest diagnostics and compiler improvements.
+                systemShells.rust-stable
+                systemShells.idris2
+                systemShells.nix
+              ];
+            };
+
+          # Idris 2 development shell for `./experiments/idris`
+          idris2 = pkgs.mkShell {
+            name = "idris2";
+            packages = [
+              # Idris 2 is currently broken on `aarch64-darwin` without
+              # resorting to some installation schenanigans with Racket:
+              # https://github.com/idris-lang/Idris2/issues/2404. For now it can
+              # just be emulated using Rosetta.
+              (if system == "aarch64-darwin" then
+                nixpkgs.legacyPackages.x86_64-darwin.idris2
+              else
+                pkgs.idris2)
+            ];
+          };
+
+          # Nix development shell
+          nix = pkgs.mkShell {
+            name = "nix";
+            packages = [ pkgs.nixpkgs-fmt ];
+          };
         } // (
+          # Rust development shells
+          #
           # Map over the `rustToolchains` defined above, creating a shell
           # environment for each.
           #
@@ -96,28 +130,29 @@
           #
           # For example, to run the tests using the `minimum` Rust toolchain:
           #
-          #     $ nix develop .#minimum --command cargo test
+          #     $ nix develop .#rust-stable --command cargo test
           #
-          lib.mapAttrs
+          lib.mapAttrs'
             (name: rustToolchain:
               let
                 rustWithExtensions = rustToolchain.override {
                   extensions = [ "rust-src" "rustfmt" "clippy" ];
                 };
               in
-              pkgs.mkShell {
-                name = "${name}-shell";
+              {
+                name = "rust-${name}";
+                value = pkgs.mkShell {
+                  name = "${name}-shell";
 
-                packages = [
-                  rustWithExtensions
-                  pkgs.nixpkgs-fmt
-                ];
+                  packages = [
+                    rustWithExtensions
+                  ];
 
-                # Print backtraces on panics
-                RUST_BACKTRACE = 1;
-
-                # Certain tools like `rust-analyzer` won't work without this
-                RUST_SRC_PATH = "${rustWithExtensions}/lib/rustlib/src/rust/library";
+                  # Print backtraces on panics
+                  RUST_BACKTRACE = 1;
+                  # Certain tools like `rust-analyzer` won't work without this
+                  RUST_SRC_PATH = "${rustWithExtensions}/lib/rustlib/src/rust/library";
+                };
               })
             rustToolchains
         );

From 02bace9b03b23a32abc071fc74dc1b29799485ae Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 25 Aug 2022 11:12:37 +1000
Subject: [PATCH 02/47] Experiment with custom IR universes

---
 experiments/idris/fathom.ipkg                 |   3 +-
 .../Closed/InductiveRecursiveCustom.idr       | 155 ++++++++++++++++++
 2 files changed, 157 insertions(+), 1 deletion(-)
 create mode 100644 experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index 250c95184..1979b36b7 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -15,8 +15,9 @@ package fathom
 -- modules to install
 modules = Fathom
         , Fathom.Base
-        , Fathom.Closed.InductiveRecursive
         , Fathom.Closed.IndexedInductive
+        , Fathom.Closed.InductiveRecursive
+        , Fathom.Closed.InductiveRecursiveCustom
         , Fathom.Open.Record
 
 -- main file (i.e. file to load at REPL)
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
new file mode 100644
index 000000000..588ba8aec
--- /dev/null
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -0,0 +1,155 @@
+||| Experimenting with an approach to extending inductive-recusive format
+||| descriptions with custom formats.
+
+module Fathom.Closed.InductiveRecursiveCustom
+
+
+import Data.Colist
+import Data.Vect
+
+import Fathom.Base
+
+
+-------------------------
+-- FORMAT DESCRIPTIONS --
+-------------------------
+
+
+||| A custom format description.
+|||
+||| We’d prefer to just import `Fathom.Open.Record`, but Idris’ imports are a
+||| bit tempramental and result in ambiguities when importing modules that
+||| contain types of the same name as those defined in the current module.
+public export
+record CustomFormat where
+  constructor MkCustomFormat
+  Rep : Type
+  decode : Decode Rep ByteStream
+  encode : Encode Rep ByteStream
+
+
+mutual
+  ||| Universe of format descriptions
+  public export
+  data Format : Type where
+    End : Format
+    Fail : Format
+    Pure : {0 A : Type} -> A -> Format
+    Skip : (f : Format) -> (def : Rep f) -> Format
+    Repeat : Nat -> Format -> Format
+    Bind : (f : Format) -> (Rep f -> Format) -> Format
+    Custom :  (f : CustomFormat) -> Format
+
+
+  ||| In-memory representation of format descriptions
+  public export
+  Rep : Format -> Type
+  Rep End = Unit
+  Rep Fail = Void
+  Rep (Skip _ _) = Unit
+  Rep (Repeat len f) = Vect len (Rep f)
+  Rep (Pure x) = Sing x
+  Rep (Bind f1 f2) = (x : Rep f1 ** Rep (f2 x))
+  Rep (Custom f) = f.Rep
+
+
+---------------------------
+-- ENCODER/DECODER PAIRS --
+---------------------------
+
+
+export
+decode : (f : Format) -> Decode (Rep f) ByteStream
+decode End [] = Just ((), [])
+decode End (_::_) = Nothing
+decode Fail _ = Nothing
+decode (Pure x) buffer =
+  Just (MkSing x, buffer)
+decode (Skip f _) buffer = do
+  (x, buffer') <- decode f buffer
+  Just ((), buffer')
+decode (Repeat 0 f) buffer =
+  Just ([], buffer)
+decode (Repeat (S len) f) buffer = do
+  (x, buffer') <- decode f buffer
+  (xs, buffer'') <- decode (Repeat len f) buffer'
+  Just (x :: xs, buffer'')
+decode (Bind f1 f2) buffer = do
+  (x, buffer') <- decode f1 buffer
+  (y, buffer'') <- decode (f2 x) buffer'
+  Just ((x ** y), buffer'')
+decode (Custom f) buffer = f.decode buffer
+
+
+export
+encode : (f : Format) -> Encode (Rep f) ByteStream
+encode End () _ = Just []
+encode (Pure x) (MkSing _) buffer = Just buffer
+encode (Skip f def) () buffer = do
+  encode f def buffer
+encode (Repeat Z f) [] buffer = Just buffer
+encode (Repeat (S len) f) (x :: xs) buffer = do
+  buffer' <- encode (Repeat len f) xs buffer
+  encode f x buffer'
+encode (Bind f1 f2) (x ** y) buffer = do
+  buffer' <- encode (f2 x) y buffer
+  encode f1 x buffer'
+encode (Custom f) x buffer = f.encode x buffer
+
+
+--------------------
+-- CUSTOM FORMATS --
+--------------------
+
+
+u8 : Format
+u8 = Custom (MkCustomFormat
+  { Rep = Bits8
+  , decode = \buffer =>
+    case buffer of
+      [] => Nothing
+      x :: buffer => Just (x, buffer)
+  , encode = \x, buffer =>
+    Just (x :: buffer)
+  })
+
+
+-----------------
+-- EXPERIMENTS --
+-----------------
+
+
+||| A format description refined with a fixed representation
+public export
+FormatOf : (0 Rep : Type) -> Type
+FormatOf rep = Refine Format (\f => Rep f = rep)
+
+
+toFormatOf : (f : Format) -> FormatOf (Rep f)
+toFormatOf f = refine f
+
+
+export
+either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
+either True f1 _ = refine f1
+either False _ f2 = refine f2
+
+
+export
+orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
+orPure True f _ = f
+orPure False _ def = refine (Pure def)
+
+
+export
+orPure' : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
+orPure' True f _ = f
+orPure' False _ def = refine (Pure def)
+
+
+foo : (cond : Bool) -> (f : Format) -> Rep f -> Format
+foo cond f def = case orPure cond (toFormatOf f) def of
+  MkRefine f' prf =>
+    Bind f' (\x => case cond of
+      True => ?todo1
+      False => ?todo2)

From 315acb12da42d02a21cfe95ed71a24159bff0854 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 25 Aug 2022 11:15:14 +1000
Subject: [PATCH 03/47] Spelling fixes

---
 experiments/idris/src/Fathom/Closed/InductiveRecursive.idr  | 4 ++--
 .../idris/src/Fathom/Closed/InductiveRecursiveCustom.idr    | 4 ++--
 experiments/idris/src/Fathom/Open/Record.idr                | 6 +++---
 experiments/idris/src/Playground.idr                        | 4 ++--
 4 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index def23d60c..4b1ea5c2f 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -2,7 +2,7 @@
 ||| the descriptions and their in-memory representation. This closely matches
 ||| the current implementation of format descriptions in Fathom.
 |||
-||| [Induction recusion](https://en.wikipedia.org/wiki/Induction-recursion) is
+||| [Induction recursion](https://en.wikipedia.org/wiki/Induction-recursion) is
 ||| where an inductive datatype is defined simultaneously with a function that
 ||| operates on that type (see the @Format and @Rep definitions below).
 |||
@@ -10,7 +10,7 @@
 ||| added to the type theory, although they can be composed out of other formats)
 |||
 ||| This is similar to the approach used when defining type theories with
-||| Tarski-style universes. In-fact inductive-recusrive datatypes as a language
+||| Tarski-style universes. In-fact inductive-recursive datatypes as a language
 ||| feature were apparently originally motivated by this use case (see: [“A
 ||| General Formulation of Simultaneous Inductive-Recursive Definitions in Type
 ||| Theory”](https://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.6.4575) by
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 588ba8aec..fff06c45d 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -1,4 +1,4 @@
-||| Experimenting with an approach to extending inductive-recusive format
+||| Experimenting with an approach to extending inductive-recursive format
 ||| descriptions with custom formats.
 
 module Fathom.Closed.InductiveRecursiveCustom
@@ -18,7 +18,7 @@ import Fathom.Base
 ||| A custom format description.
 |||
 ||| We’d prefer to just import `Fathom.Open.Record`, but Idris’ imports are a
-||| bit tempramental and result in ambiguities when importing modules that
+||| bit temperamental and result in ambiguities when importing modules that
 ||| contain types of the same name as those defined in the current module.
 public export
 record CustomFormat where
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index 3bcdada6f..bd6c14934 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -1,11 +1,11 @@
 ||| Open format universe
 |||
 ||| This module defines an open universe of binary format descriptions using
-||| records to define an inderface. By defining formats in this way, the
+||| records to define an interface. By defining formats in this way, the
 ||| universe of formats is open to extension.
 |||
-||| I’m not sure, but this reminds me a little of the ‘coinductive universes’
-||| that [some type theorists were proposing for HoTT](https://www.cmu.edu/dietrich/philosophy/hott/slides/shulman-2022-05-12.pdf#page=79),
+||| I’m not sure, but this reminds me a little of the ‘coinductively defined
+||| universes’ that [some type theorists were proposing](https://www.cmu.edu/dietrich/philosophy/hott/slides/shulman-2022-05-12.pdf#page=79),
 ||| but I may be mistaken.
 
 module Fathom.Open.Record
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index f60b1274c..393e128e3 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -13,7 +13,7 @@ import Fathom.Open.Record as Record
 -- Experiment with converting between the different styles of format universes
 
 
-||| Convert an inductive-recusive format universe into a record format
+||| Convert an inductive-recursive format universe into a record format
 public export
 format : IndRec.Format -> Record.Format
 format f = Record.MkFormat
@@ -23,7 +23,7 @@ format f = Record.MkFormat
   }
 
 
-||| Conver an indexed-inductive format universe into a record format
+||| Convert an indexed-inductive format universe into a record format
 public export
 formatOf : {Rep : Type} -> Indexed.FormatOf Rep -> Record.Format
 formatOf f = Record.MkFormat

From 6d0dc185490186e3747c8d21d69b3bee776efe5c Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 25 Aug 2022 12:03:08 +1000
Subject: [PATCH 04/47] Begin reproducing Opentype difficulties

---
 experiments/idris/src/Fathom.idr              |  6 +++
 .../Closed/InductiveRecursiveCustom.idr       | 43 +++++++++++++++++++
 2 files changed, 49 insertions(+)

diff --git a/experiments/idris/src/Fathom.idr b/experiments/idris/src/Fathom.idr
index 00781a8d2..c998deac1 100644
--- a/experiments/idris/src/Fathom.idr
+++ b/experiments/idris/src/Fathom.idr
@@ -1 +1,7 @@
 ||| A sketch of core Fathom in Idris 2
+
+import public Fathom.Base
+import public Fathom.Closed.IndexedInductive
+import public Fathom.Closed.InductiveRecursive
+import public Fathom.Closed.InductiveRecursiveCustom
+import public Fathom.Open.Record
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index fff06c45d..aeba6d1b6 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -102,6 +102,7 @@ encode (Custom f) x buffer = f.encode x buffer
 --------------------
 
 
+public export
 u8 : Format
 u8 = Custom (MkCustomFormat
   { Rep = Bits8
@@ -153,3 +154,45 @@ foo cond f def = case orPure cond (toFormatOf f) def of
     Bind f' (\x => case cond of
       True => ?todo1
       False => ?todo2)
+
+
+-- Reproduction of difficulties in OpenType format
+
+-- def flag = {
+--     flag <- u8,
+--     repeat <- match ((u8_and flag 8) != (0 : U8)) {
+--       true => u8,
+--       false => succeed U8 0,
+--     },
+-- };
+flag : Format
+flag =
+  Bind u8 (\flag =>
+    if flag == 0 then u8 else Pure {A = Bits8} 0)
+
+-- def simple_glyph = fun (number_of_contours : U16) => {
+--     ...
+--     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+--     ...
+-- };
+simple_glyph : Format
+simple_glyph =
+  -- ...
+  Bind flag (\(flag ** repeat) =>
+    let
+      repeat' : Bits8
+      repeat' = case flag of
+        0 => repeat
+        x => ?todo4
+
+      -- repeat' : Bits8
+      -- repeat' with (MkSing flag)
+      --   repeat' | MkSing 0 {prf} = rewrite sym prf in repeat
+      --   repeat' | MkSing x {prf} = ?todo4
+
+      -- repeat' : Bits8
+      -- repeat' = case MkSing flag of
+      --   MkSing 0 {prf} => ?todo3
+      --   MkSing x {prf} => ?todo4
+    in
+      Pure (repeat' + 1))

From 6be0640d560bc10e182714fcbb06e96a98a3301e Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 25 Aug 2022 12:58:01 +1000
Subject: [PATCH 05/47] Add rlwrap to devShell

This is a workaround for https://github.com/idris-lang/Idris2/issues/54
---
 flake.nix | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/flake.nix b/flake.nix
index a5de25824..d832fca4e 100644
--- a/flake.nix
+++ b/flake.nix
@@ -110,6 +110,13 @@
                 nixpkgs.legacyPackages.x86_64-darwin.idris2
               else
                 pkgs.idris2)
+              # Keyboard input is currently broken on the version of Idris 2
+              # on nixPkgs (v0.5.1). To work around this, run Idris shells with:
+              #
+              #     $ rlwrap [options] idris2 ...
+              #
+              # See: https://github.com/idris-lang/Idris2/issues/54
+              pkgs.rlwrap
             ];
           };
 

From 711c66ab7a36b3818dc7d2675e3c0128192d50fe Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 25 Aug 2022 13:02:48 +1000
Subject: [PATCH 06/47] Adjust multiplicities on singleton types

---
 experiments/idris/src/Fathom/Base.idr | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index ee5001008..cda733065 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -33,12 +33,12 @@ refine value {prf} = MkRefine { value, prf }
 ||| from the Agda docs.
 public export
 data Sing : {0 A : Type} -> (x : A) -> Type where
-  MkSing : {0 A : Type} -> {0 x : A} -> (y : A) -> {auto prf : x = y} -> Sing x
+  MkSing : {0 A : Type} -> {0 x : A} -> (0 y : A) -> {auto 0 prf : x = y} -> Sing x
 
 ||| Convert a singleton back to its underlying value
 public export
-value : {0 Val : Type} -> {0 x : Val} -> Sing x -> Val
-value (MkSing y) = y
+value : {0 Val : Type} -> {x : Val} -> Sing x -> Val
+value (MkSing _) = x
 
 
 ---------------------------

From 6487cea15fb1b11a1d46a8d36c2a232ad14b46c2 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 25 Aug 2022 13:16:32 +1000
Subject: [PATCH 07/47] Switch to using records for singletons

---
 experiments/idris/src/Fathom/Base.idr            | 16 ++++++++++++----
 .../idris/src/Fathom/Closed/IndexedInductive.idr |  2 +-
 .../src/Fathom/Closed/InductiveRecursive.idr     |  4 ++--
 .../Fathom/Closed/InductiveRecursiveCustom.idr   |  4 ++--
 experiments/idris/src/Fathom/Open/Record.idr     |  2 +-
 5 files changed, 18 insertions(+), 10 deletions(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index cda733065..17ea85efd 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -19,12 +19,12 @@ record Refine (0 A : Type) (0 P : A -> Type) where
   ||| The wrapped value
   value : A
   ||| The proof of the proposition
-  0 prf : P value
+  {auto 0 prf : P value}
 
 ||| Refine a value with a proposition
 public export
 refine : {0 A : Type} -> {0 P : A -> Type} -> (value : A) -> {auto 0 prf : P value} -> Refine A P
-refine value {prf} = MkRefine { value, prf }
+refine value = MkRefine { value }
 
 
 ||| Singleton types
@@ -32,8 +32,16 @@ refine value {prf} = MkRefine { value, prf }
 ||| Inspired by [this type](https://agda.readthedocs.io/en/v2.5.4.1/language/with-abstraction.html#the-inspect-idiom)
 ||| from the Agda docs.
 public export
-data Sing : {0 A : Type} -> (x : A) -> Type where
-  MkSing : {0 A : Type} -> {0 x : A} -> (0 y : A) -> {auto 0 prf : x = y} -> Sing x
+record Sing {0 A : Type} (x : A) where
+  constructor MkSing
+  0 value : A
+  {auto 0 prf : x = value}
+
+
+||| Convert a singleton back to its underlying value
+public export
+sing : {0 A : Type} -> {0 x : A} -> (0 value : A) -> {auto 0 prf : x = value} -> Sing x
+sing value = MkSing { value }
 
 ||| Convert a singleton back to its underlying value
 public export
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 4a0e01e15..b5c3e25a1 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -37,7 +37,7 @@ decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
 decode (Pure x) buffer =
-  Just (MkSing x, buffer)
+  Just (sing x, buffer)
 decode (Skip f _) buffer = do
   (x, buffer') <- decode f buffer
   Just ((), buffer')
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 4b1ea5c2f..cadab23a9 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -87,7 +87,7 @@ decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
 decode (Pure x) buffer =
-  Just (MkSing x, buffer)
+  Just (sing x, buffer)
 decode (Skip f _) buffer = do
   (x, buffer') <- decode f buffer
   Just ((), buffer')
@@ -173,7 +173,7 @@ orPure' False _ def = refine (Pure def)
 
 foo : (cond : Bool) -> (f : Format) -> Rep f -> Format
 foo cond f def = case orPure cond (toFormatOf f) def of
-  MkRefine f' prf =>
+  MkRefine f' {prf} =>
     Bind f' (\x => case cond of
       True => ?todo1
       False => ?todo2)
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index aeba6d1b6..ac7c103ee 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -64,7 +64,7 @@ decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
 decode (Pure x) buffer =
-  Just (MkSing x, buffer)
+  Just (sing x, buffer)
 decode (Skip f _) buffer = do
   (x, buffer') <- decode f buffer
   Just ((), buffer')
@@ -150,7 +150,7 @@ orPure' False _ def = refine (Pure def)
 
 foo : (cond : Bool) -> (f : Format) -> Rep f -> Format
 foo cond f def = case orPure cond (toFormatOf f) def of
-  MkRefine f' prf =>
+  MkRefine f' {prf} =>
     Bind f' (\x => case cond of
       True => ?todo1
       False => ?todo2)
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index bd6c14934..271e9d65c 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -57,7 +57,7 @@ pure x = MkFormat { Rep, decode, encode } where
   Rep = Sing x
 
   decode : Decode Rep BitStream
-  decode buffer = Just (MkSing x, buffer)
+  decode buffer = Just (sing x, buffer)
 
   encode : Encode Rep BitStream
   encode (MkSing _) buffer = Just buffer

From 9f0cd55b358add0bb17ff4d505d61eec500547bd Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 25 Aug 2022 13:22:55 +1000
Subject: [PATCH 08/47] Move refinement and singleton types into modules

---
 experiments/idris/fathom.ipkg                 |  2 +
 experiments/idris/src/Fathom/Base.idr         | 44 -------------------
 .../src/Fathom/Closed/IndexedInductive.idr    |  3 +-
 .../src/Fathom/Closed/InductiveRecursive.idr  | 14 +++---
 .../Closed/InductiveRecursiveCustom.idr       | 14 +++---
 experiments/idris/src/Fathom/Data/Refine.idr  | 15 +++++++
 experiments/idris/src/Fathom/Data/Sing.idr    | 23 ++++++++++
 experiments/idris/src/Fathom/Open/Record.idr  |  3 +-
 experiments/idris/src/Playground.idr          |  1 +
 9 files changed, 61 insertions(+), 58 deletions(-)
 create mode 100644 experiments/idris/src/Fathom/Data/Refine.idr
 create mode 100644 experiments/idris/src/Fathom/Data/Sing.idr

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index 1979b36b7..a663133da 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -15,6 +15,8 @@ package fathom
 -- modules to install
 modules = Fathom
         , Fathom.Base
+        , Fathom.Data.Sing
+        , Fathom.Data.Refine
         , Fathom.Closed.IndexedInductive
         , Fathom.Closed.InductiveRecursive
         , Fathom.Closed.InductiveRecursiveCustom
diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index 17ea85efd..64dd7605f 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -5,50 +5,6 @@ import Data.Colist
 import Data.List
 
 
-------------------
--- USEFUL TYPES --
-------------------
-
-
-||| A value that is refined by a proposition.
-|||
-||| This is a bit like `(x : A ** B)`, but with the second element erased.
-public export
-record Refine (0 A : Type) (0 P : A -> Type) where
-  constructor MkRefine
-  ||| The wrapped value
-  value : A
-  ||| The proof of the proposition
-  {auto 0 prf : P value}
-
-||| Refine a value with a proposition
-public export
-refine : {0 A : Type} -> {0 P : A -> Type} -> (value : A) -> {auto 0 prf : P value} -> Refine A P
-refine value = MkRefine { value }
-
-
-||| Singleton types
-|||
-||| Inspired by [this type](https://agda.readthedocs.io/en/v2.5.4.1/language/with-abstraction.html#the-inspect-idiom)
-||| from the Agda docs.
-public export
-record Sing {0 A : Type} (x : A) where
-  constructor MkSing
-  0 value : A
-  {auto 0 prf : x = value}
-
-
-||| Convert a singleton back to its underlying value
-public export
-sing : {0 A : Type} -> {0 x : A} -> (0 value : A) -> {auto 0 prf : x = value} -> Sing x
-sing value = MkSing { value }
-
-||| Convert a singleton back to its underlying value
-public export
-value : {0 Val : Type} -> {x : Val} -> Sing x -> Val
-value (MkSing _) = x
-
-
 ---------------------------
 -- ENCODER/DECODER PAIRS --
 ---------------------------
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index b5c3e25a1..205c431a8 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -8,6 +8,7 @@ import Data.Colist
 import Data.Vect
 
 import Fathom.Base
+import Fathom.Data.Sing
 
 
 -------------------------
@@ -37,7 +38,7 @@ decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
 decode (Pure x) buffer =
-  Just (sing x, buffer)
+  Just (MkSing x, buffer)
 decode (Skip f _) buffer = do
   (x, buffer') <- decode f buffer
   Just ((), buffer')
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index cadab23a9..db7f67a9a 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -26,6 +26,8 @@ import Data.Colist
 import Data.Vect
 
 import Fathom.Base
+import Fathom.Data.Sing
+import Fathom.Data.Refine
 
 -- import Fathom.Open.Record
 
@@ -87,7 +89,7 @@ decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
 decode (Pure x) buffer =
-  Just (sing x, buffer)
+  Just (MkSing x, buffer)
 decode (Skip f _) buffer = do
   (x, buffer') <- decode f buffer
   Just ((), buffer')
@@ -150,25 +152,25 @@ FormatOf rep = Refine Format (\f => Rep f = rep)
 
 
 toFormatOf : (f : Format) -> FormatOf (Rep f)
-toFormatOf f = refine f
+toFormatOf f = MkRefine f
 
 
 export
 either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
-either True f1 _ = refine f1
-either False _ f2 = refine f2
+either True f1 _ = MkRefine f1
+either False _ f2 = MkRefine f2
 
 
 export
 orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
 orPure True f _ = f
-orPure False _ def = refine (Pure def)
+orPure False _ def = MkRefine (Pure def)
 
 
 export
 orPure' : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
 orPure' True f _ = f
-orPure' False _ def = refine (Pure def)
+orPure' False _ def = MkRefine (Pure def)
 
 
 foo : (cond : Bool) -> (f : Format) -> Rep f -> Format
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index ac7c103ee..fbeb8b4d7 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -8,6 +8,8 @@ import Data.Colist
 import Data.Vect
 
 import Fathom.Base
+import Fathom.Data.Sing
+import Fathom.Data.Refine
 
 
 -------------------------
@@ -64,7 +66,7 @@ decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
 decode (Pure x) buffer =
-  Just (sing x, buffer)
+  Just (MkSing x, buffer)
 decode (Skip f _) buffer = do
   (x, buffer') <- decode f buffer
   Just ((), buffer')
@@ -127,25 +129,25 @@ FormatOf rep = Refine Format (\f => Rep f = rep)
 
 
 toFormatOf : (f : Format) -> FormatOf (Rep f)
-toFormatOf f = refine f
+toFormatOf f = MkRefine f
 
 
 export
 either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
-either True f1 _ = refine f1
-either False _ f2 = refine f2
+either True f1 _ = MkRefine f1
+either False _ f2 = MkRefine f2
 
 
 export
 orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
 orPure True f _ = f
-orPure False _ def = refine (Pure def)
+orPure False _ def = MkRefine (Pure def)
 
 
 export
 orPure' : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
 orPure' True f _ = f
-orPure' False _ def = refine (Pure def)
+orPure' False _ def = MkRefine (Pure def)
 
 
 foo : (cond : Bool) -> (f : Format) -> Rep f -> Format
diff --git a/experiments/idris/src/Fathom/Data/Refine.idr b/experiments/idris/src/Fathom/Data/Refine.idr
new file mode 100644
index 000000000..fca14a0b0
--- /dev/null
+++ b/experiments/idris/src/Fathom/Data/Refine.idr
@@ -0,0 +1,15 @@
+module Fathom.Data.Refine
+
+
+||| A value that is refined by a proposition.
+|||
+||| The proof of the proposition is erased at runtime.
+|||
+||| This is a bit like `(x : A ** B)`, but with the second element erased.
+public export
+record Refine (0 A : Type) (0 P : A -> Type) where
+  constructor MkRefine
+  ||| The refined value
+  val : A
+  ||| The a proof that @val is refined by @P
+  {auto 0 prf : P val}
diff --git a/experiments/idris/src/Fathom/Data/Sing.idr b/experiments/idris/src/Fathom/Data/Sing.idr
new file mode 100644
index 000000000..0be2899b6
--- /dev/null
+++ b/experiments/idris/src/Fathom/Data/Sing.idr
@@ -0,0 +1,23 @@
+module Fathom.Data.Sing
+
+
+||| A singleton type, constrained to be a single value
+|||
+||| The underlying value and the proof are both erased at runtime, as they can
+||| be converted back to the index by reconstructing the value as required.
+|||
+||| Inspired by the singleton type [found in Adga’s documentation](https://agda.readthedocs.io/en/v2.5.4.1/language/with-abstraction.html#the-inspect-idiom).
+public export
+record Sing {0 A : Type} (x : A) where
+  constructor MkSing
+  ||| The underlying value of the singleton (erased at run-time)
+  0 val : A
+  ||| A proof that @val is the same as the indexed value (erased at run-time)
+  {auto 0 prf : x = val}
+
+
+||| Convert a singleton back to its underlying value restoring it with a value
+||| constructed runtime
+public export
+val : {0 A : Type} -> {x : A} -> Sing x -> A
+val (MkSing _) = x
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index 271e9d65c..1032d057b 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -15,6 +15,7 @@ import Data.Colist
 import Data.Vect
 
 import Fathom.Base
+import Fathom.Data.Sing
 
 
 public export
@@ -57,7 +58,7 @@ pure x = MkFormat { Rep, decode, encode } where
   Rep = Sing x
 
   decode : Decode Rep BitStream
-  decode buffer = Just (sing x, buffer)
+  decode buffer = Just (MkSing x, buffer)
 
   encode : Encode Rep BitStream
   encode (MkSing _) buffer = Just buffer
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index 393e128e3..1a3a98f7e 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -5,6 +5,7 @@ import Data.Colist
 import Data.Vect
 
 import Fathom.Base
+import Fathom.Data.Sing
 import Fathom.Closed.InductiveRecursive as IndRec
 import Fathom.Closed.IndexedInductive as Indexed
 import Fathom.Open.Record as Record

From 6511e44a7eb5b3816ec1e65fe664de487cca464b Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Tue, 30 Aug 2022 15:38:11 +1000
Subject: [PATCH 09/47] Add some more notes about the Idris sketch

---
 experiments/idris/README.md | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/experiments/idris/README.md b/experiments/idris/README.md
index 01f35f0cf..1751141e9 100644
--- a/experiments/idris/README.md
+++ b/experiments/idris/README.md
@@ -2,7 +2,26 @@
 
 Some sketches of Fathom’s core language using Idris as a logical framework.
 
+> **Note:**
+>
+> Idris 2 does not yet support cumulatively or full totality checking, so the
+> definitions here may depend on inconsistency. We also don’t aim to prove any
+> properties of these definitions, this is more intended for experimentation.
+
+## Development setup
+
+Depends on the following:
+
+- [Idris 2](https://github.com/idris-lang/Idris2/blob/main/INSTALL.md)
+- [rlwrap](https://github.com/hanslub42/rlwrap) (optional - as a workaround for
+  [idris-lang/Idris2#54](https://github.com/idris-lang/Idris2/issues/54))
+
+If you use NixPkgs the above is installed as part of the default development
+shell in the [flake.nix](../../flake.nix) provided.
+
+## Usage
+
 ```command
-$ idris2 --repl experiments/idris/fathom.ipkg
+$ rlwrap idris2 --repl experiments/idris/fathom.ipkg
 Main> :load "src/Playground.idr"
 ```

From 01a285283882787d3bf72fd6cbe156e412439abd Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Tue, 30 Aug 2022 15:38:46 +1000
Subject: [PATCH 10/47] Add name hints for streams

---
 experiments/idris/src/Fathom/Base.idr | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index 64dd7605f..0052df73c 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -52,20 +52,28 @@ public export
 BitStream : Type
 BitStream = Colist Bool
 
+%name BitStream stream
+
 
 ||| A possibly infinite stream of bytes
 public export
 ByteStream : Type
 ByteStream = Colist Bits8
 
+%name ByteStream stream
+
 
 ||| A finite bit buffer
 public export
 BitBuffer : Type
 BitBuffer = List Bool
 
+%name BitBuffer buffer
+
 
 ||| A finite byte buffer
 public export
 ByteBuffer : Type
 ByteBuffer = List Bits8
+
+%name ByteBuffer buffer

From 93055a4b56c150ee50149b3fc479321386aebe9d Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Tue, 30 Aug 2022 16:48:03 +1000
Subject: [PATCH 11/47] Implement a simpler singleton type

---
 .../Closed/InductiveRecursiveCustom.idr       | 12 ++--
 experiments/idris/src/Fathom/Data/Sing.idr    | 64 +++++++++++++++----
 2 files changed, 57 insertions(+), 19 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index fbeb8b4d7..79c47154b 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -188,13 +188,13 @@ simple_glyph =
         x => ?todo4
 
       -- repeat' : Bits8
-      -- repeat' with (MkSing flag)
-      --   repeat' | MkSing 0 {prf} = rewrite sym prf in repeat
-      --   repeat' | MkSing x {prf} = ?todo4
+      -- repeat' with (MkSingEq flag)
+      --   repeat' | MkSingEq 0 {prf} = rewrite sym prf in repeat
+      --   repeat' | MkSingEq x {prf} = ?todo4
 
       -- repeat' : Bits8
-      -- repeat' = case MkSing flag of
-      --   MkSing 0 {prf} => ?todo3
-      --   MkSing x {prf} => ?todo4
+      -- repeat' = case MkSingEq flag of
+      --   MkSingEq 0 {prf} => ?todo3
+      --   MkSingEq x {prf} => ?todo4
     in
       Pure (repeat' + 1))
diff --git a/experiments/idris/src/Fathom/Data/Sing.idr b/experiments/idris/src/Fathom/Data/Sing.idr
index 0be2899b6..f364e42af 100644
--- a/experiments/idris/src/Fathom/Data/Sing.idr
+++ b/experiments/idris/src/Fathom/Data/Sing.idr
@@ -1,23 +1,61 @@
 module Fathom.Data.Sing
 
 
-||| A singleton type, constrained to be a single value
+||| A type constrained to a single value
 |||
-||| The underlying value and the proof are both erased at runtime, as they can
-||| be converted back to the index by reconstructing the value as required.
-|||
-||| Inspired by the singleton type [found in Adga’s documentation](https://agda.readthedocs.io/en/v2.5.4.1/language/with-abstraction.html#the-inspect-idiom).
+||| The underlying value is erased at runtime, as it can be converted back to
+||| the index by reconstructing the value as required.
 public export
-record Sing {0 A : Type} (x : A) where
-  constructor MkSing
-  ||| The underlying value of the singleton (erased at run-time)
-  0 val : A
-  ||| A proof that @val is the same as the indexed value (erased at run-time)
-  {auto 0 prf : x = val}
+data Sing : {0 A : Type} -> (x : A) -> Type where
+  MkSing : {0 A : Type} -> (0 x : A) -> Sing x
 
 
-||| Convert a singleton back to its underlying value restoring it with a value
-||| constructed runtime
+||| Reconstruct a singleton with a runtime value.
 public export
 val : {0 A : Type} -> {x : A} -> Sing x -> A
 val (MkSing _) = x
+
+
+||| Update the value contained in a singleton with a function.
+export
+map : {0 A, B : Type} -> {0 x : A} -> (f : A -> B) -> Sing x -> Sing (f x)
+map f (MkSing y) = MkSing (f y)
+
+
+
+namespace SingEq
+  -- NOTE: Unsure if this representation is actually needed?
+
+  ||| A type constrained to be a single value, with an associated equality proof.
+  |||
+  ||| The underlying value and the proof are both erased at runtime, as they can
+  ||| be converted back to the index by reconstructing the value as required.
+  |||
+  ||| Inspired by the singleton type [found in Adga’s documentation](https://agda.readthedocs.io/en/v2.5.4.1/language/with-abstraction.html#the-inspect-idiom).
+  public export
+  record SingEq {0 A : Type} (x : A) where
+    constructor MkSingEq
+    ||| The underlying value of the singleton (erased at run-time)
+    0 val : A
+    ||| A proof that @val is the same as the indexed value (erased at run-time)
+    {auto 0 prf : x = val}
+
+
+  ||| Convert a singleton back to its underlying value restoring it with a value
+  ||| constructed runtime
+  public export
+  val : {0 A : Type} -> {x : A} -> SingEq x -> A
+  val (MkSingEq _) = x
+
+
+  ||| Update the value contained in a singleton with a function.
+  export
+  map : {0 A, B : Type} -> {0 x : A} -> (f : A -> B) -> SingEq x -> SingEq (f x)
+  map f (MkSingEq y {prf}) = MkSingEq (f y) {prf = cong f prf}
+
+
+withEq : {0 A : Type} -> {0 x : A} -> Sing x -> SingEq x
+withEq (MkSing x) = MkSingEq x
+
+withoutEq : {0 A : Type} -> {0 x : A} -> SingEq x -> Sing x
+withoutEq {x} (MkSingEq _) = MkSing x

From 505f286d19b56a972ccf0391f9d085365aab5bb7 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Tue, 30 Aug 2022 17:14:40 +1000
Subject: [PATCH 12/47] Simplify the encoder type

---
 experiments/idris/src/Fathom/Base.idr         |  6 ++--
 .../src/Fathom/Closed/IndexedInductive.idr    | 19 +++++-------
 .../src/Fathom/Closed/InductiveRecursive.idr  | 31 +++++++++----------
 .../Closed/InductiveRecursiveCustom.idr       | 24 ++++++--------
 experiments/idris/src/Fathom/Open/Record.idr  | 19 +++++-------
 5 files changed, 43 insertions(+), 56 deletions(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index 0052df73c..aca854183 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -30,16 +30,16 @@ parameters (Source : Type, Target : Type)
   Decode : Type
   Decode = Target -> Maybe (Source, Target)
 
-  ||| Encoders take a _source value_ and _remaining target value_ and produce either:
+  ||| Encoders take a _source value_ and produce either:
   |||
-  ||| - an _updated target value_
+  ||| - a _target value_
   ||| - or nothing if in error occurred
   |||
   ||| @ Source  The type of source values (usually an in-memory data structure)
   ||| @ Target  The type of target values (usually a byte-stream)
   public export
   Encode : Type
-  Encode = Source -> Target -> Maybe Target
+  Encode = Source -> Maybe Target
 
 
 ----------------------
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 205c431a8..34ec1a6ce 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -56,17 +56,14 @@ decode (Bind f1 f2) buffer = do
 
 export
 encode : {0 Rep : Type} -> (f : FormatOf Rep) -> Encode Rep (Colist a)
-encode End () _ = Just []
-encode (Pure x) (MkSing _) buffer = Just buffer
-encode (Skip f def) () buffer = do
-  encode f def buffer
-encode (Repeat Z f) [] buffer = Just buffer
-encode (Repeat (S len) f) (x :: xs) buffer = do
-  buffer' <- encode (Repeat len f) xs buffer
-  encode f x buffer'
-encode (Bind f1 f2) (x ** y) buffer = do
-  buffer' <- encode (f2 x) y buffer
-  encode f1 x buffer'
+encode End () = Just []
+encode (Pure x) (MkSing _) = Just []
+encode (Skip f def) () = encode f def
+encode (Repeat Z f) [] = Just []
+encode (Repeat (S len) f) (x :: xs) =
+  [| encode f x <+> encode (Repeat len f) xs |]
+encode (Bind f1 f2) (x ** y) =
+  [| encode f1 x <+> encode (f2 x) y |]
 
 
 -----------------
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index db7f67a9a..9a30a6d45 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -119,25 +119,22 @@ decode (Bind f1 f2) buffer = do
 
 export
 encode : (f : Format) -> Encode (Rep f) (Colist a)
-encode End () _ = Just []
-encode (Pure x) (MkSing _) buffer = Just buffer
-encode (Skip f def) () buffer = do
-  encode f def buffer
-encode (Repeat Z f) [] buffer = Just buffer
-encode (Repeat (S len) f) (x :: xs) buffer = do
-  buffer' <- encode (Repeat len f) xs buffer
-  encode f x buffer'
-encode (Bind f1 f2) (x ** y) buffer = do
-  buffer' <- encode (f2 x) y buffer
-  encode f1 x buffer'
+encode End () = Just []
+encode (Pure x) (MkSing _) = Just []
+encode (Skip f def) () = encode f def
+encode (Repeat Z f) [] = Just []
+encode (Repeat (S len) f) (x :: xs) = do
+  [| encode f x <+> encode (Repeat len f) xs |]
+encode (Bind f1 f2) (x ** y) = do
+  [| encode f1 x <+> encode (f2 x) y |]
 -- Questionable format descriptions
--- encode (OrPure True f _) x buffer = encode f x buffer
--- encode (OrPure False _ def) x buffer = Just buffer
--- encode (OfSing f r) x buffer = do
---   buffer' <- encode f ?todo_x buffer
+-- encode (OrPure True f _) x = encode f x
+-- encode (OrPure False _ def) x = Just []
+-- encode (OfSing f r) x = do
+--   buffer' <- encode f ?todo_x
 --   ?todo_encode
--- encode (OfEq f _ {prf}) x buffer = do
---   encode f (rewrite prf in x) buffer
+-- encode (OfEq f _ {prf}) x = do
+--   encode f (rewrite prf in x)
 
 
 -----------------
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 79c47154b..c7856236f 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -85,18 +85,15 @@ decode (Custom f) buffer = f.decode buffer
 
 export
 encode : (f : Format) -> Encode (Rep f) ByteStream
-encode End () _ = Just []
-encode (Pure x) (MkSing _) buffer = Just buffer
-encode (Skip f def) () buffer = do
-  encode f def buffer
-encode (Repeat Z f) [] buffer = Just buffer
-encode (Repeat (S len) f) (x :: xs) buffer = do
-  buffer' <- encode (Repeat len f) xs buffer
-  encode f x buffer'
-encode (Bind f1 f2) (x ** y) buffer = do
-  buffer' <- encode (f2 x) y buffer
-  encode f1 x buffer'
-encode (Custom f) x buffer = f.encode x buffer
+encode End () = Just []
+encode (Pure x) (MkSing _) = Just []
+encode (Skip f def) () = encode f def
+encode (Repeat Z f) [] = Just []
+encode (Repeat (S len) f) (x :: xs) =
+  [| encode f x <+> encode (Repeat len f) xs |]
+encode (Bind f1 f2) (x ** y) =
+  [| encode f1 x <+> encode (f2 x) y |]
+encode (Custom f) x = f.encode x
 
 
 --------------------
@@ -112,8 +109,7 @@ u8 = Custom (MkCustomFormat
     case buffer of
       [] => Nothing
       x :: buffer => Just (x, buffer)
-  , encode = \x, buffer =>
-    Just (x :: buffer)
+  , encode = \x => Just [x]
   })
 
 
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index 1032d057b..54cd88ccd 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -37,7 +37,7 @@ end = MkFormat { Rep, decode, encode } where
   decode (_::_) = Nothing
 
   encode : Encode Rep BitStream
-  encode () _ = Just []
+  encode () = Just []
 
 public export
 fail : Format
@@ -61,7 +61,7 @@ pure x = MkFormat { Rep, decode, encode } where
   decode buffer = Just (MkSing x, buffer)
 
   encode : Encode Rep BitStream
-  encode (MkSing _) buffer = Just buffer
+  encode (MkSing _) = Just []
 
 public export
 skip : (f : Format) -> (def : f.Rep) -> Format
@@ -75,8 +75,7 @@ skip f def = MkFormat { Rep, decode, encode } where
     Just ((), buffer')
 
   encode : Encode Rep BitStream
-  encode () buffer = do
-    f.encode def buffer
+  encode () = f.encode def
 
 
 public export
@@ -97,10 +96,9 @@ repeat len f = MkFormat { Rep, decode, encode } where
   encode : Encode Rep BitStream
   encode = go len where
     go : (len : Nat) -> Encode (Vect len f.Rep) BitStream
-    go 0 [] buffer = Just buffer
-    go (S len) (x :: xs) buffer = do
-      buffer' <- go len xs buffer
-      f.encode x buffer'
+    go 0 [] = Just []
+    go (S len) (x :: xs) =
+      [| f.encode x <+> go len xs |]
 
 
 public export
@@ -116,6 +114,5 @@ bind f1 f2 = MkFormat { Rep, decode, encode } where
     Just ((x ** y), buffer'')
 
   encode : Encode Rep BitStream
-  encode (x ** y) buffer = do
-    buffer' <- (f2 x).encode y buffer
-    f1.encode x buffer'
+  encode (x ** y) =
+    [| f1.encode x <+> (f2 x).encode y |]

From 6e8660ab591fd8c773d673e33342ba7bae013ddd Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Tue, 30 Aug 2022 17:52:14 +1000
Subject: [PATCH 13/47] Add support for do notation

---
 .../src/Fathom/Closed/IndexedInductive.idr    | 10 +++
 .../src/Fathom/Closed/InductiveRecursive.idr  | 11 ++++
 .../Closed/InductiveRecursiveCustom.idr       | 65 ++++++++++++-------
 experiments/idris/src/Fathom/Open/Record.idr  | 37 +++++++++++
 4 files changed, 100 insertions(+), 23 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 34ec1a6ce..ebbf9e9ae 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -27,6 +27,16 @@ data FormatOf : (0 Rep : Type) -> Type where
   Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
 
 
+-- Support for do notation
+
+public export
+pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
+pure = Pure
+
+public export
+(>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+(>>=) = Bind
+
 
 ---------------------------
 -- ENCODER/DECODER PAIRS --
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 9a30a6d45..48b7c73ae 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -78,6 +78,17 @@ mutual
   -- Rep (Custom f) = f.Rep
 
 
+-- Support for do notation
+
+public export
+pure : {0 A : Type} -> A -> Format
+pure = Pure
+
+public export
+(>>=) : (f : Format) -> (Rep f -> Format) -> Format
+(>>=) = Bind
+
+
 ---------------------------
 -- ENCODER/DECODER PAIRS --
 ---------------------------
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index c7856236f..59c7fdc7f 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -96,6 +96,21 @@ encode (Bind f1 f2) (x ** y) =
 encode (Custom f) x = f.encode x
 
 
+--------------
+-- NOTATION --
+--------------
+
+-- Support for do notation
+
+public export
+pure : {0 A : Type} -> A -> Format
+pure = Pure
+
+public export
+(>>=) : (f : Format) -> (Rep f -> Format) -> Format
+(>>=) = Bind
+
+
 --------------------
 -- CUSTOM FORMATS --
 --------------------
@@ -164,9 +179,10 @@ foo cond f def = case orPure cond (toFormatOf f) def of
 --     },
 -- };
 flag : Format
-flag =
-  Bind u8 (\flag =>
-    if flag == 0 then u8 else Pure {A = Bits8} 0)
+flag = do
+  flag <- u8
+  if flag == 0 then u8 else
+    Pure {A = Bits8} 0
 
 -- def simple_glyph = fun (number_of_contours : U16) => {
 --     ...
@@ -174,23 +190,26 @@ flag =
 --     ...
 -- };
 simple_glyph : Format
-simple_glyph =
-  -- ...
-  Bind flag (\(flag ** repeat) =>
-    let
-      repeat' : Bits8
-      repeat' = case flag of
-        0 => repeat
-        x => ?todo4
-
-      -- repeat' : Bits8
-      -- repeat' with (MkSingEq flag)
-      --   repeat' | MkSingEq 0 {prf} = rewrite sym prf in repeat
-      --   repeat' | MkSingEq x {prf} = ?todo4
-
-      -- repeat' : Bits8
-      -- repeat' = case MkSingEq flag of
-      --   MkSingEq 0 {prf} => ?todo3
-      --   MkSingEq x {prf} => ?todo4
-    in
-      Pure (repeat' + 1))
+simple_glyph = do
+  (flag ** repeat) <- flag
+  let
+    repeat' : Bits8
+    repeat' = case flag of
+      0 => repeat
+      x => ?todo4
+
+    -- repeat' : Bits8
+    -- repeat' with (flag)
+    --   repeat' | 0 = ?todo3
+    --   repeat' | x = ?todo4
+
+    -- repeat' : Bits8
+    -- repeat' with (MkSingEq flag)
+    --   repeat' | MkSingEq 0 {prf} = ?help
+    --   repeat' | MkSingEq x {prf} = ?todo4
+
+    -- repeat' : Bits8
+    -- repeat' = case MkSingEq flag of
+    --   MkSingEq 0 {prf} => ?todo3
+    --   MkSingEq x {prf} => ?todo4
+  Pure (repeat' + 1)
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index 54cd88ccd..2055829c6 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -15,9 +15,15 @@ import Data.Colist
 import Data.Vect
 
 import Fathom.Base
+import Fathom.Data.Refine
 import Fathom.Data.Sing
 
 
+-------------------------
+-- FORMAT DESCRIPTIONS --
+-------------------------
+
+
 public export
 record Format where
   constructor MkFormat
@@ -26,6 +32,11 @@ record Format where
   encode : Encode Rep BitStream
 
 
+--------------
+-- FORMATS --
+--------------
+
+
 public export
 end : Format
 end = MkFormat { Rep, decode, encode } where
@@ -39,6 +50,7 @@ end = MkFormat { Rep, decode, encode } where
   encode : Encode Rep BitStream
   encode () = Just []
 
+
 public export
 fail : Format
 fail = MkFormat { Rep, decode, encode } where
@@ -51,6 +63,7 @@ fail = MkFormat { Rep, decode, encode } where
   encode : Encode Rep BitStream
   encode x = void x
 
+
 public export
 pure : {0 A : Type} -> A -> Format
 pure x = MkFormat { Rep, decode, encode } where
@@ -63,6 +76,7 @@ pure x = MkFormat { Rep, decode, encode } where
   encode : Encode Rep BitStream
   encode (MkSing _) = Just []
 
+
 public export
 skip : (f : Format) -> (def : f.Rep) -> Format
 skip f def = MkFormat { Rep, decode, encode } where
@@ -116,3 +130,26 @@ bind f1 f2 = MkFormat { Rep, decode, encode } where
   encode : Encode Rep BitStream
   encode (x ** y) =
     [| f1.encode x <+> (f2 x).encode y |]
+
+
+-- Support for do notation
+
+public export
+(>>=) : (f : Format) -> (Rep f -> Format) -> Format
+(>>=) = bind
+
+
+
+-----------------
+-- EXPERIMENTS --
+-----------------
+
+
+||| A format description refined with a fixed representation
+public export
+FormatOf : (0 Rep : Type) -> Type
+FormatOf rep = Refine Format (\f => f.Rep = rep)
+
+
+toFormatOf : (f : Format) -> FormatOf f.Rep
+toFormatOf f = MkRefine f

From 53d50c6a5c6eeb6cda709b53fa801ef3c8d006fe Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Tue, 30 Aug 2022 18:15:35 +1000
Subject: [PATCH 14/47] Make Decode type match Source more closely

---
 experiments/idris/src/Fathom/Base.idr            |  5 ++---
 .../idris/src/Fathom/Closed/IndexedInductive.idr |  2 +-
 .../src/Fathom/Closed/InductiveRecursive.idr     |  2 +-
 .../Fathom/Closed/InductiveRecursiveCustom.idr   |  4 ++--
 experiments/idris/src/Fathom/Open/Record.idr     | 16 ++++++++--------
 5 files changed, 14 insertions(+), 15 deletions(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index aca854183..f3ba88554 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -21,14 +21,13 @@ parameters (Source : Type, Target : Type)
 
   ||| Decoders consume a _target value_ and produce either:
   |||
-  ||| - a _source value_ and _remaining target value_
+  ||| - a _source value_
   ||| - or nothing if in error occurred
   |||
   ||| @ Source  The type of source values (usually an in-memory data structure)
-  ||| @ Target  The type of target values (usually a byte-stream)
   public export
   Decode : Type
-  Decode = Target -> Maybe (Source, Target)
+  Decode = Target -> Maybe Source
 
   ||| Encoders take a _source value_ and produce either:
   |||
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index ebbf9e9ae..67668ac69 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -43,7 +43,7 @@ public export
 ---------------------------
 
 export
-decode : {0 Rep : Type} -> (f : FormatOf Rep) -> Decode Rep (Colist a)
+decode : {0 Rep : Type} -> (f : FormatOf Rep) -> Decode (Rep, Colist a) (Colist a)
 decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 48b7c73ae..ef0ec6074 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -95,7 +95,7 @@ public export
 
 
 export
-decode : (f : Format) -> Decode (Rep f) (Colist a)
+decode : (f : Format) -> Decode (Rep f, Colist a) (Colist a)
 decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 59c7fdc7f..ba71945e7 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -26,7 +26,7 @@ public export
 record CustomFormat where
   constructor MkCustomFormat
   Rep : Type
-  decode : Decode Rep ByteStream
+  decode : Decode (Rep, ByteStream) ByteStream
   encode : Encode Rep ByteStream
 
 
@@ -61,7 +61,7 @@ mutual
 
 
 export
-decode : (f : Format) -> Decode (Rep f) ByteStream
+decode : (f : Format) -> Decode (Rep f, ByteStream) ByteStream
 decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index 2055829c6..d8e5cfecf 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -28,7 +28,7 @@ public export
 record Format where
   constructor MkFormat
   Rep : Type
-  decode : Decode Rep BitStream
+  decode : Decode (Rep, BitStream) BitStream
   encode : Encode Rep BitStream
 
 
@@ -43,7 +43,7 @@ end = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = Unit
 
-  decode : Decode Rep BitStream
+  decode : Decode (Rep, BitStream) BitStream
   decode [] = Just ((), [])
   decode (_::_) = Nothing
 
@@ -57,7 +57,7 @@ fail = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = Void
 
-  decode : Decode Rep BitStream
+  decode : Decode (Rep, BitStream) BitStream
   decode _ = Nothing
 
   encode : Encode Rep BitStream
@@ -70,7 +70,7 @@ pure x = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = Sing x
 
-  decode : Decode Rep BitStream
+  decode : Decode (Rep, BitStream) BitStream
   decode buffer = Just (MkSing x, buffer)
 
   encode : Encode Rep BitStream
@@ -83,7 +83,7 @@ skip f def = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = ()
 
-  decode : Decode Rep BitStream
+  decode : Decode (Rep, BitStream) BitStream
   decode buffer = do
     (x, buffer') <- f.decode buffer
     Just ((), buffer')
@@ -98,9 +98,9 @@ repeat len f = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = Vect len f.Rep
 
-  decode : Decode Rep BitStream
+  decode : Decode (Rep, BitStream) BitStream
   decode = go len where
-    go : (len : Nat) -> Decode (Vect len f.Rep) BitStream
+    go : (len : Nat) -> Decode (Vect len f.Rep, BitStream) BitStream
     go 0 buffer = Just ([], buffer)
     go (S len) buffer = do
       (x, buffer') <- f.decode buffer
@@ -121,7 +121,7 @@ bind f1 f2 = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = (x : f1.Rep ** (f2 x).Rep)
 
-  decode : Decode Rep BitStream
+  decode : Decode (Rep, BitStream) BitStream
   decode buffer = do
     (x, buffer') <- f1.decode buffer
     (y, buffer'') <- (f2 x).decode buffer'

From 728917657f4038204f0b0885a37a1b46c1885f51 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Tue, 30 Aug 2022 19:51:24 +1000
Subject: [PATCH 15/47] Try a different FormatOf representation

---
 .../src/Fathom/Closed/IndexedInductive.idr    | 13 +++-
 .../src/Fathom/Closed/InductiveRecursive.idr  | 29 +++------
 .../Closed/InductiveRecursiveCustom.idr       | 22 +++----
 experiments/idris/src/Fathom/Open/Record.idr  |  9 +--
 experiments/idris/src/Playground.idr          | 62 +++++--------------
 5 files changed, 44 insertions(+), 91 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 67668ac69..460ed606a 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -18,7 +18,7 @@ import Fathom.Data.Sing
 
 ||| Universe of format descriptions indexed by their machine representations
 public export
-data FormatOf : (0 Rep : Type) -> Type where
+data FormatOf : (0 A : Type) -> Type where
   End : FormatOf Unit
   Fail : FormatOf Void
   Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
@@ -42,8 +42,9 @@ public export
 -- ENCODER/DECODER PAIRS --
 ---------------------------
 
+
 export
-decode : {0 Rep : Type} -> (f : FormatOf Rep) -> Decode (Rep, Colist a) (Colist a)
+decode : {0 A, S : Type} -> (f : FormatOf A) -> Decode (A, Colist S) (Colist S)
 decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
@@ -65,7 +66,7 @@ decode (Bind f1 f2) buffer = do
 
 
 export
-encode : {0 Rep : Type} -> (f : FormatOf Rep) -> Encode Rep (Colist a)
+encode : {0 A, S : Type} -> (f : FormatOf A) -> Encode A (Colist S)
 encode End () = Just []
 encode (Pure x) (MkSing _) = Just []
 encode (Skip f def) () = encode f def
@@ -81,6 +82,12 @@ encode (Bind f1 f2) (x ** y) =
 -----------------
 
 
+record Format where
+  constructor MkFormat
+  0 Repr : Type
+  Format : FormatOf Repr
+
+
 either : (cond : Bool) -> FormatOf a -> FormatOf b -> FormatOf (if cond then a else b)
 either True f1 _ = f1
 either False _ f2 = f2
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index ef0ec6074..239ea3423 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -27,7 +27,6 @@ import Data.Vect
 
 import Fathom.Base
 import Fathom.Data.Sing
-import Fathom.Data.Refine
 
 -- import Fathom.Open.Record
 
@@ -155,35 +154,23 @@ encode (Bind f1 f2) (x ** y) = do
 
 ||| A format description refined with a fixed representation
 public export
-FormatOf : (0 Rep : Type) -> Type
-FormatOf rep = Refine Format (\f => Rep f = rep)
-
-
-toFormatOf : (f : Format) -> FormatOf (Rep f)
-toFormatOf f = MkRefine f
+data FormatOf : (0 A : Type) -> Type where
+  MkFormatOf : (f : Format) -> FormatOf (Rep f)
 
 
 export
 either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
-either True f1 _ = MkRefine f1
-either False _ f2 = MkRefine f2
+either True f1 _ = MkFormatOf f1
+either False _ f2 = MkFormatOf f2
 
 
-export
+public export
 orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
 orPure True f _ = f
-orPure False _ def = MkRefine (Pure def)
+orPure False _ def = MkFormatOf (Pure def)
 
 
-export
+public export
 orPure' : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
 orPure' True f _ = f
-orPure' False _ def = MkRefine (Pure def)
-
-
-foo : (cond : Bool) -> (f : Format) -> Rep f -> Format
-foo cond f def = case orPure cond (toFormatOf f) def of
-  MkRefine f' {prf} =>
-    Bind f' (\x => case cond of
-      True => ?todo1
-      False => ?todo2)
+orPure' False _ def = MkFormatOf (Pure def)
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index ba71945e7..c6cb3889a 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -135,38 +135,30 @@ u8 = Custom (MkCustomFormat
 
 ||| A format description refined with a fixed representation
 public export
-FormatOf : (0 Rep : Type) -> Type
-FormatOf rep = Refine Format (\f => Rep f = rep)
+data FormatOf : (0 Rep : Type) -> Type where
+  MkFormatOf : (f : Format) -> FormatOf (Rep f)
 
 
 toFormatOf : (f : Format) -> FormatOf (Rep f)
-toFormatOf f = MkRefine f
+toFormatOf f = MkFormatOf f
 
 
 export
 either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
-either True f1 _ = MkRefine f1
-either False _ f2 = MkRefine f2
+either True f1 _ = MkFormatOf f1
+either False _ f2 = MkFormatOf f2
 
 
 export
 orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
 orPure True f _ = f
-orPure False _ def = MkRefine (Pure def)
+orPure False _ def = MkFormatOf (Pure def)
 
 
 export
 orPure' : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
 orPure' True f _ = f
-orPure' False _ def = MkRefine (Pure def)
-
-
-foo : (cond : Bool) -> (f : Format) -> Rep f -> Format
-foo cond f def = case orPure cond (toFormatOf f) def of
-  MkRefine f' {prf} =>
-    Bind f' (\x => case cond of
-      True => ?todo1
-      False => ?todo2)
+orPure' False _ def = MkFormatOf (Pure def)
 
 
 -- Reproduction of difficulties in OpenType format
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index d8e5cfecf..a837a0337 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -15,7 +15,6 @@ import Data.Colist
 import Data.Vect
 
 import Fathom.Base
-import Fathom.Data.Refine
 import Fathom.Data.Sing
 
 
@@ -147,9 +146,5 @@ public export
 
 ||| A format description refined with a fixed representation
 public export
-FormatOf : (0 Rep : Type) -> Type
-FormatOf rep = Refine Format (\f => f.Rep = rep)
-
-
-toFormatOf : (f : Format) -> FormatOf f.Rep
-toFormatOf f = MkRefine f
+data FormatOf : (0 A : Type) -> Type where
+  MkFormatOf : (f : Format) -> FormatOf f.Rep
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index 1a3a98f7e..cb3279d00 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -71,50 +71,22 @@ indRecToIndexed (Pure x) = Indexed.Pure x
 indRecToIndexed (Skip f def) = Indexed.Skip (indRecToIndexed f) def
 indRecToIndexed (Repeat len f) = Indexed.Repeat len (indRecToIndexed f)
 indRecToIndexed (Bind f g) = Indexed.Bind (indRecToIndexed f) (\x => indRecToIndexed (g x))
--- indRecToIndexed (OfSing f (MkSing _ {prf})) = rewrite sym prf in indRecToIndexed f
--- indRecToIndexed (OfEq f _ {prf}) = rewrite sym prf in indRecToIndexed f
-
-
--- ||| Convert an indexed format description to an inductive-recursive format
--- indexedToIndRec : {0 Rep : Type} -> (f : Indexed.FormatOf Rep) -> IndRec.FormatOf Rep
--- indexedToIndRec End = MkRefine { value = IndRec.End, prf = Refl }
--- indexedToIndRec Fail = MkRefine { value = IndRec.Fail, prf = Refl }
--- indexedToIndRec (Pure x) = MkRefine { value = IndRec.Pure x, prf = Refl }
--- indexedToIndRec (Skip {a} f def) =
---   let
---     MkRefine f' prf = indexedToIndRec f
---     symPrf = sym prf
---     def' = rewrite prf in def
---   in
---     MkRefine { value = IndRec.Skip f' ?todoDef, prf = ?todoSkip }
--- indexedToIndRec (Repeat len f) = MkRefine { value = IndRec.Repeat _ _, prf = ?todoRepeat }
--- indexedToIndRec (Bind f g) = MkRefine { value = IndRec.Bind _ _, prf = ?todoBind }
+
 
 ||| Convert an indexed format description to an inductive-recursive format
-indexedToIndRec : {0 Rep : Type} -> (f : Indexed.FormatOf Rep) -> IndRec.Format
-indexedToIndRec End = IndRec.End
-indexedToIndRec Fail = IndRec.Fail
-indexedToIndRec (Pure x) = IndRec.Pure x
-indexedToIndRec (Skip f def) =
-  IndRec.Skip (indexedToIndRec f) ?todo_def
---                                ^^^^^^^^^
--- Error: While processing right hand side of indexedToIndRec. Can't solve constraint between: a and Rep (indexedToIndRec f).
---
---    def : a
---    f : FormatOf a
---  0 Rep : Type
--- ------------------------------
--- todo_def : Rep (indexedToIndRec f)
---
-indexedToIndRec (Repeat len f) = IndRec.Repeat len (indexedToIndRec f)
-indexedToIndRec (Bind f1 f2) = IndRec.Bind (indexedToIndRec f1) (\x => indexedToIndRec ?todo_f2)
---                                                                                     ^^^^^^^^
--- Error: While processing right hand side of indexedToIndRec. Can't solve constraint
--- between: Rep (indexedToIndRec f1) and a (implicitly bound at Fathom.Test:86:1--86:95).
---
---    f2 : (x : a) -> FormatOf (b x)
---    f1 : FormatOf a
---  0 Rep : Type
---    x : Rep (indexedToIndRec f1)
--- ------------------------------
--- todo_f2 : FormatOf ?Rep
+indexedToIndRec : {0 A : Type} -> (f : Indexed.FormatOf A) -> IndRec.FormatOf A
+indexedToIndRec End = MkFormatOf IndRec.End
+indexedToIndRec Fail = MkFormatOf IndRec.Fail
+indexedToIndRec (Pure x) = MkFormatOf (IndRec.Pure x)
+indexedToIndRec (Skip f def) with (indexedToIndRec f)
+  indexedToIndRec (Skip _ def) | MkFormatOf f = MkFormatOf (IndRec.Skip f def)
+indexedToIndRec (Repeat len f) with (indexedToIndRec f)
+  indexedToIndRec (Repeat len _) | MkFormatOf f = MkFormatOf (IndRec.Repeat len f)
+indexedToIndRec (Bind f1 f2) with (indexedToIndRec f1)
+  indexedToIndRec (Bind _ f2) | MkFormatOf f1 =
+    --    f1 : Format
+    --  0 A : Type
+    --    f2 : (x : Rep f1) -> FormatOf (B x)
+    -- ------------------------------
+    -- todo_indexedToIndRec : FormatOf (DPair (Rep f1) (\x => B x))
+    ?todo_indexedToIndRec

From 9e15d99ecb357cac438711a59bbaef1bcc00f8be Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Wed, 31 Aug 2022 17:32:41 +1000
Subject: [PATCH 16/47] Add more type aliases for encoder/decoder pairs

---
 experiments/idris/src/Fathom/Base.idr | 45 ++++++++++++++++++++++++++-
 1 file changed, 44 insertions(+), 1 deletion(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index f3ba88554..97efa9b27 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -17,7 +17,7 @@ import Data.List
 --
 -- TODO: Add support for [Narcissus-style stores](https://github.com/mit-plv/fiat/tree/master/src/Narcissus/Stores)
 
-parameters (Source : Type, Target : Type)
+parameters (Source, Target : Type)
 
   ||| Decoders consume a _target value_ and produce either:
   |||
@@ -25,10 +25,12 @@ parameters (Source : Type, Target : Type)
   ||| - or nothing if in error occurred
   |||
   ||| @ Source  The type of source values (usually an in-memory data structure)
+  ||| @ Target  The type of target values (usually a byte-stream)
   public export
   Decode : Type
   Decode = Target -> Maybe Source
 
+
   ||| Encoders take a _source value_ and produce either:
   |||
   ||| - a _target value_
@@ -41,6 +43,47 @@ parameters (Source : Type, Target : Type)
   Encode = Source -> Maybe Target
 
 
+parameters (Source, Target : Type)
+
+  ||| Decode a portion of a _target value_, leaving some remaining for
+  ||| subsequent decoding.
+  |||
+  ||| @ Source  The type of source values (usually an in-memory data structure)
+  ||| @ Target  The type of target values (usually a byte-stream)
+  public export
+  DecodePart : Type
+  DecodePart = Decode (Source, Target) Target
+
+
+  ||| Consumes a _source value_ and the remaining _target value_, returning
+  ||| a fully encoded target value.
+  |||
+  ||| @ Source  The type of source values (usually an in-memory data structure)
+  ||| @ Target  The type of target values (usually a byte-stream)
+  public export
+  EncodePart : Type
+  EncodePart = Encode (Source, Target) Target
+
+
+parameters {0 Source, Target : Type}
+
+  public export
+  toDecodeFull : (Monoid Target, Eq Target) => DecodePart Source Target -> Decode Source Target
+  toDecodeFull decode target = do
+    (source, target') <- decode target
+    if target == neutral then Just source else Nothing
+
+
+  public export
+  toEncodeFull : Monoid Target => EncodePart Source Target -> Encode Source Target
+  toEncodeFull encode source = encode (source, neutral)
+
+
+  public export
+  toEncodePart : Monoid Target => Encode Source Target -> EncodePart Source Target
+  toEncodePart encode (source, target) = [| encode source <+> Just target |]
+
+
 ----------------------
 -- ENCODING TARGETS --
 ----------------------

From e0c52d7aacc707c56f4fc14fd0fb276adeb42c5b Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Wed, 31 Aug 2022 17:34:48 +1000
Subject: [PATCH 17/47] Add more encoding targets

---
 experiments/idris/src/Fathom/Base.idr | 28 +++++++++++++++++++++------
 1 file changed, 22 insertions(+), 6 deletions(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index 97efa9b27..cb30d01de 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -89,20 +89,20 @@ parameters {0 Source, Target : Type}
 ----------------------
 
 
-||| A possibly infinite stream of bits
+||| A potentially infinite stream of bits
 public export
 BitStream : Type
 BitStream = Colist Bool
 
-%name BitStream stream
+%name BitStream bits
 
 
-||| A possibly infinite stream of bytes
+||| A potentially infinite stream of bytes
 public export
 ByteStream : Type
 ByteStream = Colist Bits8
 
-%name ByteStream stream
+%name ByteStream bytes
 
 
 ||| A finite bit buffer
@@ -110,7 +110,7 @@ public export
 BitBuffer : Type
 BitBuffer = List Bool
 
-%name BitBuffer buffer
+%name BitBuffer bits
 
 
 ||| A finite byte buffer
@@ -118,4 +118,20 @@ public export
 ByteBuffer : Type
 ByteBuffer = List Bits8
 
-%name ByteBuffer buffer
+%name ByteBuffer bytes
+
+
+||| An array of bits of a known size
+public export
+BitArray : Nat -> Type
+BitArray len = Vect len Bool
+
+%name BitArray bits
+
+
+||| An array of bytes of a known size
+public export
+ByteArray : Nat -> Type
+ByteArray len = Vect len Bits8
+
+%name ByteArray bytes

From 305a0ceb182ae4738f1363b5f2b9a584b0b1c01e Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Wed, 31 Aug 2022 18:47:40 +1000
Subject: [PATCH 18/47] Various cleanups

---
 .../src/Fathom/Closed/IndexedInductive.idr    |  1 +
 .../src/Fathom/Closed/InductiveRecursive.idr  | 20 -------------------
 experiments/idris/src/Playground.idr          |  5 -----
 3 files changed, 1 insertion(+), 25 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 460ed606a..4cdaa380a 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -82,6 +82,7 @@ encode (Bind f1 f2) (x ** y) =
 -----------------
 
 
+public export
 record Format where
   constructor MkFormat
   0 Repr : Type
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 239ea3423..9fc97755e 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -114,18 +114,6 @@ decode (Bind f1 f2) buffer = do
   (y, buffer'') <- decode (f2 x) buffer'
   Just ((x ** y), buffer'')
 
--- Questionable format descriptions
--- decode (OrPure True f _) buffer = decode f buffer
--- decode (OrPure False _ def) buffer = Just (def, buffer)
--- decode (OfSing f (MkSing r {prf})) buffer = do
---   (x, buffer') <- decode f buffer
---   Just (rewrite sym prf in x, buffer')
--- decode (OfEq f _ {prf}) buffer = do
---   (x, buffer') <- decode f buffer
---   Just (rewrite sym prf in x, buffer')
-
--- Broken stuff
-
 
 export
 encode : (f : Format) -> Encode (Rep f) (Colist a)
@@ -137,14 +125,6 @@ encode (Repeat (S len) f) (x :: xs) = do
   [| encode f x <+> encode (Repeat len f) xs |]
 encode (Bind f1 f2) (x ** y) = do
   [| encode f1 x <+> encode (f2 x) y |]
--- Questionable format descriptions
--- encode (OrPure True f _) x = encode f x
--- encode (OrPure False _ def) x = Just []
--- encode (OfSing f r) x = do
---   buffer' <- encode f ?todo_x
---   ?todo_encode
--- encode (OfEq f _ {prf}) x = do
---   encode f (rewrite prf in x)
 
 
 -----------------
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index cb3279d00..9d3b777a0 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -84,9 +84,4 @@ indexedToIndRec (Repeat len f) with (indexedToIndRec f)
   indexedToIndRec (Repeat len _) | MkFormatOf f = MkFormatOf (IndRec.Repeat len f)
 indexedToIndRec (Bind f1 f2) with (indexedToIndRec f1)
   indexedToIndRec (Bind _ f2) | MkFormatOf f1 =
-    --    f1 : Format
-    --  0 A : Type
-    --    f2 : (x : Rep f1) -> FormatOf (B x)
-    -- ------------------------------
-    -- todo_indexedToIndRec : FormatOf (DPair (Rep f1) (\x => B x))
     ?todo_indexedToIndRec

From 0d5fa66fd5bce59da4b7ff36667df50058f3fc07 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Wed, 31 Aug 2022 18:49:08 +1000
Subject: [PATCH 19/47] Experiment with bit and word definitions

---
 experiments/idris/fathom.ipkg              |  2 +
 experiments/idris/src/Fathom/Data/Bit.idr  | 71 ++++++++++++++++++++++
 experiments/idris/src/Fathom/Data/Word.idr | 26 ++++++++
 3 files changed, 99 insertions(+)
 create mode 100644 experiments/idris/src/Fathom/Data/Bit.idr
 create mode 100644 experiments/idris/src/Fathom/Data/Word.idr

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index a663133da..fede16644 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -15,8 +15,10 @@ package fathom
 -- modules to install
 modules = Fathom
         , Fathom.Base
+        , Fathom.Data.Bit
         , Fathom.Data.Sing
         , Fathom.Data.Refine
+        , Fathom.Data.Word
         , Fathom.Closed.IndexedInductive
         , Fathom.Closed.InductiveRecursive
         , Fathom.Closed.InductiveRecursiveCustom
diff --git a/experiments/idris/src/Fathom/Data/Bit.idr b/experiments/idris/src/Fathom/Data/Bit.idr
new file mode 100644
index 000000000..ad7aab6ca
--- /dev/null
+++ b/experiments/idris/src/Fathom/Data/Bit.idr
@@ -0,0 +1,71 @@
+||| Binary digits
+
+module Fathom.Data.Bit
+
+
+||| A binary digit
+public export
+data Bit : Type where
+  B0 : Bit
+  B1 : Bit
+
+
+public export
+Cast Bit Bool where
+  cast B0 = True
+  cast B1 = False
+
+public export
+Cast Bit Nat where
+  cast B0 = 0
+  cast B1 = 1
+
+public export
+Cast Bit Int where
+  cast B0 = 0
+  cast B1 = 1
+
+public export
+Cast Bit Integer where
+  cast B0 = 0
+  cast B1 = 1
+
+public export
+Cast Bit Bits8 where
+  cast B0 = 0
+  cast B1 = 1
+
+public export
+Cast Bit Bits16 where
+  cast B0 = 0
+  cast B1 = 1
+
+public export
+Cast Bit Bits32 where
+  cast B0 = 0
+  cast B1 = 1
+
+public export
+Cast Bit Bits64 where
+  cast B0 = 0
+  cast B1 = 1
+
+public export
+Cast Bit Int8 where
+  cast B0 = 0
+  cast B1 = 1
+
+public export
+Cast Bit Int16 where
+  cast B0 = 0
+  cast B1 = 1
+
+public export
+Cast Bit Int32 where
+  cast B0 = 0
+  cast B1 = 1
+
+public export
+Cast Bit Int64 where
+  cast B0 = 0
+  cast B1 = 1
diff --git a/experiments/idris/src/Fathom/Data/Word.idr b/experiments/idris/src/Fathom/Data/Word.idr
new file mode 100644
index 000000000..4dac845cd
--- /dev/null
+++ b/experiments/idris/src/Fathom/Data/Word.idr
@@ -0,0 +1,26 @@
+module Fathom.Data.Word
+
+
+import Data.Fin
+
+import Fathom.Data.Bit
+
+
+||| A binary word with a specified number of bits
+public export
+data Word : (0 size : Nat) -> Type where
+  Z : Word 0
+  S : Bit -> {0 n : Nat} -> Word n -> Word (S n)
+
+
+export
+Cast (Word size) Nat where
+  cast Z = 0
+  cast (S B0 w) = cast w * 2
+  cast (S B1 w) = S (cast w * 2)
+
+export
+Cast (Word size) Bits8 where
+  cast Z = 0
+  cast (S B0 w) = cast w * 2
+  cast (S B1 w) = (cast w * 2) + 1

From 41832aab12bb96d0d7e75c77a3511fd984cbb2b3 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Wed, 31 Aug 2022 18:49:57 +1000
Subject: [PATCH 20/47] Add some more formats

---
 experiments/idris/src/Fathom/Base.idr         | 64 +++++++++++++++++++
 .../Closed/InductiveRecursiveCustom.idr       | 32 ++++++++--
 experiments/idris/src/Fathom/Open/Record.idr  | 64 ++++++++++++++-----
 3 files changed, 137 insertions(+), 23 deletions(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index cb30d01de..b2e071d78 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -1,8 +1,10 @@
 module Fathom.Base
 
 
+import Data.Bits
 import Data.Colist
 import Data.List
+import Data.Vect
 
 
 ---------------------------
@@ -135,3 +137,65 @@ ByteArray : Nat -> Type
 ByteArray len = Vect len Bits8
 
 %name ByteArray bytes
+
+
+||| The byte order of some encoded data, usually a number.
+public export
+data ByteOrder : Type where
+  LE : ByteOrder
+  BE : ByteOrder
+
+
+namespace ByteStream
+
+  splitLen : (n : Nat) -> Colist a -> Maybe (Vect n a, Colist a)
+  splitLen 0 _ = Nothing
+  splitLen (S k) [] = Nothing
+  splitLen (S k) (x :: rest) = map (\(xs, rest') => (x :: xs, rest')) (splitLen k rest)
+
+
+  export
+  decodeU8 : Decode (Bits8, ByteStream) ByteStream
+  decodeU8 [] = Nothing
+  decodeU8 (x :: bytes) =  Just (x, bytes)
+
+
+  export
+  encodeU8 : Encode Bits8 ByteStream
+  encodeU8 x = Just [x]
+
+
+  export
+  decodeU16 : ByteOrder -> Decode (Bits16, ByteStream) ByteStream
+  decodeU16 LE bytes = do
+    (bs, bytes') <- splitLen 2 bytes
+    let [b0, b1] = map (cast {to = Bits16}) bs
+    Just (b0 .|. b1 `shiftL` fromNat 8, bytes')
+  decodeU16 BE bytes = do
+    (bs, bytes') <- splitLen 2 bytes
+    let [b0, b1] = map (cast {to = Bits16}) bs
+    Just (b0 `shiftL` fromNat 8 .|. b1, bytes')
+
+
+  export
+  encodeU16 : ByteOrder -> Encode Bits16 ByteStream
+  encodeU16 LE x = Just [cast x, cast (x `shiftR` fromNat 8)]
+  encodeU16 BE x = Just [cast (x `shiftR` fromNat 8), cast x]
+
+
+  export
+  decodeU32 : ByteOrder -> Decode (Bits32, ByteStream) ByteStream
+  decodeU32 LE bytes = do
+    (bs, bytes') <- splitLen 4 bytes
+    let [b0, b1, b2, b3] = map (cast {to = Bits32}) bs
+    Just (b0 .|. b1 `shiftL` fromNat 8 .|. b2 `shiftL` fromNat 16 .|. b2 `shiftL` fromNat 24, bytes')
+  decodeU32 BE bytes = do
+    (bs, bytes') <- splitLen 4 bytes
+    let [b0, b1, b2, b3] = map (cast {to = Bits32}) bs
+    Just (b0 `shiftL` fromNat 24 .|. b1 `shiftL` fromNat 16 .|. b2 `shiftL` fromNat 8 .|. b3, bytes')
+
+
+  export
+  encodeU32 : ByteOrder -> Encode Bits32 ByteStream
+  encodeU32 LE x = Just [cast x, cast (x `shiftR` fromNat 8), cast (x `shiftR` fromNat 16), cast (x `shiftR` fromNat 24)]
+  encodeU32 BE x = Just [cast (x `shiftR` fromNat 24), cast (x `shiftR` fromNat 16), cast (x `shiftR` fromNat 8), cast x]
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index c6cb3889a..18456bc6c 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -4,8 +4,10 @@
 module Fathom.Closed.InductiveRecursiveCustom
 
 
+import Data.Bits
 import Data.Colist
 import Data.Vect
+import Data.DPair
 
 import Fathom.Base
 import Fathom.Data.Sing
@@ -120,11 +122,26 @@ public export
 u8 : Format
 u8 = Custom (MkCustomFormat
   { Rep = Bits8
-  , decode = \buffer =>
-    case buffer of
-      [] => Nothing
-      x :: buffer => Just (x, buffer)
-  , encode = \x => Just [x]
+  , decode = decodeU8
+  , encode = encodeU8
+  })
+
+
+public export
+u16Le : Format
+u16Le = Custom (MkCustomFormat
+  { Rep = Bits16
+  , decode = decodeU16 LE
+  , encode = encodeU16 LE
+  })
+
+
+public export
+u16Be : Format
+u16Be = Custom (MkCustomFormat
+  { Rep = Bits16
+  , decode = decodeU16 BE
+  , encode = encodeU16 BE
   })
 
 
@@ -173,8 +190,9 @@ orPure' False _ def = MkFormatOf (Pure def)
 flag : Format
 flag = do
   flag <- u8
-  if flag == 0 then u8 else
+  repeat <- if flag == 0 then u8 else
     Pure {A = Bits8} 0
+  Pure ()
 
 -- def simple_glyph = fun (number_of_contours : U16) => {
 --     ...
@@ -183,7 +201,7 @@ flag = do
 -- };
 simple_glyph : Format
 simple_glyph = do
-  (flag ** repeat) <- flag
+  (flag ** repeat ** MkSing ()) <- flag
   let
     repeat' : Bits8
     repeat' = case flag of
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index a837a0337..e93750939 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -27,8 +27,8 @@ public export
 record Format where
   constructor MkFormat
   Rep : Type
-  decode : Decode (Rep, BitStream) BitStream
-  encode : Encode Rep BitStream
+  decode : Decode (Rep, ByteStream) ByteStream
+  encode : Encode Rep ByteStream
 
 
 --------------
@@ -42,11 +42,11 @@ end = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = Unit
 
-  decode : Decode (Rep, BitStream) BitStream
+  decode : Decode (Rep, ByteStream) ByteStream
   decode [] = Just ((), [])
   decode (_::_) = Nothing
 
-  encode : Encode Rep BitStream
+  encode : Encode Rep ByteStream
   encode () = Just []
 
 
@@ -56,10 +56,10 @@ fail = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = Void
 
-  decode : Decode (Rep, BitStream) BitStream
+  decode : Decode (Rep, ByteStream) ByteStream
   decode _ = Nothing
 
-  encode : Encode Rep BitStream
+  encode : Encode Rep ByteStream
   encode x = void x
 
 
@@ -69,10 +69,10 @@ pure x = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = Sing x
 
-  decode : Decode (Rep, BitStream) BitStream
+  decode : Decode (Rep, ByteStream) ByteStream
   decode buffer = Just (MkSing x, buffer)
 
-  encode : Encode Rep BitStream
+  encode : Encode Rep ByteStream
   encode (MkSing _) = Just []
 
 
@@ -82,12 +82,12 @@ skip f def = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = ()
 
-  decode : Decode (Rep, BitStream) BitStream
+  decode : Decode (Rep, ByteStream) ByteStream
   decode buffer = do
     (x, buffer') <- f.decode buffer
     Just ((), buffer')
 
-  encode : Encode Rep BitStream
+  encode : Encode Rep ByteStream
   encode () = f.encode def
 
 
@@ -97,18 +97,18 @@ repeat len f = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = Vect len f.Rep
 
-  decode : Decode (Rep, BitStream) BitStream
+  decode : Decode (Rep, ByteStream) ByteStream
   decode = go len where
-    go : (len : Nat) -> Decode (Vect len f.Rep, BitStream) BitStream
+    go : (len : Nat) -> Decode (Vect len f.Rep, ByteStream) ByteStream
     go 0 buffer = Just ([], buffer)
     go (S len) buffer = do
       (x, buffer') <- f.decode buffer
       (xs, buffer'') <- go len buffer'
       Just (x :: xs, buffer'')
 
-  encode : Encode Rep BitStream
+  encode : Encode Rep ByteStream
   encode = go len where
-    go : (len : Nat) -> Encode (Vect len f.Rep) BitStream
+    go : (len : Nat) -> Encode (Vect len f.Rep) ByteStream
     go 0 [] = Just []
     go (S len) (x :: xs) =
       [| f.encode x <+> go len xs |]
@@ -120,13 +120,13 @@ bind f1 f2 = MkFormat { Rep, decode, encode } where
   Rep : Type
   Rep = (x : f1.Rep ** (f2 x).Rep)
 
-  decode : Decode (Rep, BitStream) BitStream
+  decode : Decode (Rep, ByteStream) ByteStream
   decode buffer = do
     (x, buffer') <- f1.decode buffer
     (y, buffer'') <- (f2 x).decode buffer'
     Just ((x ** y), buffer'')
 
-  encode : Encode Rep BitStream
+  encode : Encode Rep ByteStream
   encode (x ** y) =
     [| f1.encode x <+> (f2 x).encode y |]
 
@@ -138,6 +138,38 @@ public export
 (>>=) = bind
 
 
+--------------------
+-- CUSTOM FORMATS --
+--------------------
+
+
+public export
+u8 : Format
+u8 = MkFormat
+  { Rep = Bits8
+  , decode = decodeU8
+  , encode = encodeU8
+  }
+
+
+public export
+u16Le : Format
+u16Le = MkFormat
+  { Rep = Bits16
+  , decode = decodeU16 LE
+  , encode = encodeU16 LE
+  }
+
+
+public export
+u16Be : Format
+u16Be = MkFormat
+  { Rep = Bits16
+  , decode = decodeU16 BE
+  , encode = encodeU16 BE
+  }
+
+
 
 -----------------
 -- EXPERIMENTS --

From 9bf5144560a6187662ab3c2dde31f8f24f7d551b Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Wed, 31 Aug 2022 20:41:52 +1000
Subject: [PATCH 21/47] Try out the opentype issue with indexed types

---
 experiments/idris/fathom.ipkg                 |   1 +
 experiments/idris/src/Fathom/Base.idr         |  14 +-
 .../src/Fathom/Closed/IndexedInductive.idr    |   9 +-
 .../Fathom/Closed/IndexedInductiveCustom.idr  | 191 ++++++++++++++++++
 4 files changed, 212 insertions(+), 3 deletions(-)
 create mode 100644 experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index fede16644..9031ab6ce 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -20,6 +20,7 @@ modules = Fathom
         , Fathom.Data.Refine
         , Fathom.Data.Word
         , Fathom.Closed.IndexedInductive
+        , Fathom.Closed.IndexedInductiveCustom
         , Fathom.Closed.InductiveRecursive
         , Fathom.Closed.InductiveRecursiveCustom
         , Fathom.Open.Record
diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index b2e071d78..006a9878e 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -67,6 +67,18 @@ parameters (Source, Target : Type)
   EncodePart = Encode (Source, Target) Target
 
 
+namespace DecodePart
+
+  public export
+  pure : {0 S, T : Type} -> S -> DecodePart S T
+  pure source target = Just (source, target)
+
+  public export
+  map : {0 S1, S2, T : Type} -> (S1 -> S2) -> DecodePart S1 T -> DecodePart S2 T
+  map f decode target =
+    Prelude.map (\(source, target') => (f source, target)) (decode target)
+
+
 parameters {0 Source, Target : Type}
 
   public export
@@ -151,7 +163,7 @@ namespace ByteStream
   splitLen : (n : Nat) -> Colist a -> Maybe (Vect n a, Colist a)
   splitLen 0 _ = Nothing
   splitLen (S k) [] = Nothing
-  splitLen (S k) (x :: rest) = map (\(xs, rest') => (x :: xs, rest')) (splitLen k rest)
+  splitLen (S k) (x :: rest) = Prelude.map (\(xs, rest') => (x :: xs, rest')) (splitLen k rest)
 
 
   export
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 4cdaa380a..2f2046fd0 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -85,8 +85,13 @@ encode (Bind f1 f2) (x ** y) =
 public export
 record Format where
   constructor MkFormat
-  0 Repr : Type
-  Format : FormatOf Repr
+  0 Rep : Type
+  Format : FormatOf Rep
+
+
+public export
+toFormatOf : (f : Format) -> FormatOf f.Rep
+toFormatOf (MkFormat _ f) = f
 
 
 either : (cond : Bool) -> FormatOf a -> FormatOf b -> FormatOf (if cond then a else b)
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
new file mode 100644
index 000000000..157cafac8
--- /dev/null
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -0,0 +1,191 @@
+||| A closed universe of format descriptions as an inductive type, where the
+||| in-memory representation is tracked as an index on the type.
+
+module Fathom.Closed.IndexedInductiveCustom
+
+
+import Data.Colist
+import Data.Vect
+
+import Fathom.Base
+
+
+-------------------------
+-- FORMAT DESCRIPTIONS --
+-------------------------
+
+
+||| A custom format description.
+|||
+||| We’d prefer to just import `Fathom.Open.Record`, but Idris’ imports are a
+||| bit temperamental and result in ambiguities when importing modules that
+||| contain types of the same name as those defined in the current module.
+public export
+record CustomFormat where
+  constructor MkCustomFormat
+  Rep : Type
+  decode : Decode (Rep, ByteStream) ByteStream
+  encode : Encode Rep ByteStream
+
+
+||| Universe of format descriptions indexed by their machine representations
+public export
+data FormatOf : (0 A : Type) -> Type where
+  End : FormatOf Unit
+  Fail : FormatOf Void
+  Pure : {0 A : Type} -> (x : A) -> FormatOf A
+  Skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
+  Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+  Custom :  (f : CustomFormat) -> FormatOf f.Rep
+
+
+-- Support for do notation
+
+public export
+pure : {0 A : Type} -> (x : A) -> FormatOf A
+pure = Pure
+
+public export
+(>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+(>>=) = Bind
+
+
+---------------------------
+-- ENCODER/DECODER PAIRS --
+---------------------------
+
+
+export
+decode : {0 A : Type} -> (f : FormatOf A) -> Decode (A, ByteStream) (ByteStream)
+decode End [] = Just ((), [])
+decode End (_::_) = Nothing
+decode Fail _ = Nothing
+decode (Pure x) buffer =
+  Just (x, buffer)
+decode (Skip f _) buffer = do
+  (x, buffer') <- decode f buffer
+  Just ((), buffer')
+decode (Repeat 0 f) buffer =
+  Just ([], buffer)
+decode (Repeat (S len) f) buffer = do
+  (x, buffer') <- decode f buffer
+  (xs, buffer'') <- decode (Repeat len f) buffer'
+  Just (x :: xs, buffer'')
+decode (Bind f1 f2) buffer = do
+  (x, buffer') <- decode f1 buffer
+  (y, buffer'') <- decode (f2 x) buffer'
+  Just ((x ** y), buffer'')
+decode (Custom f) buffer = f.decode buffer
+
+
+export
+encode : {0 A : Type} -> (f : FormatOf A) -> Encode A (ByteStream)
+encode End () = Just []
+encode (Pure x) _ = Just []
+encode (Skip f def) () = encode f def
+encode (Repeat Z f) [] = Just []
+encode (Repeat (S len) f) (x :: xs) =
+  [| encode f x <+> encode (Repeat len f) xs |]
+encode (Bind f1 f2) (x ** y) =
+  [| encode f1 x <+> encode (f2 x) y |]
+encode (Custom f) x = f.encode x
+
+
+--------------------
+-- CUSTOM FORMATS --
+--------------------
+
+
+public export
+u8 : FormatOf Nat
+u8 = Custom (MkCustomFormat
+  { Rep = Nat
+  , decode = map cast decodeU8
+  , encode = encodeU8 . cast {to = Bits8}
+  })
+
+
+public export
+u16Le : FormatOf Nat
+u16Le = Custom (MkCustomFormat
+  { Rep = Nat
+  , decode = map cast (decodeU16 LE)
+  , encode = encodeU16 LE . cast {to = Bits16}
+  })
+
+
+public export
+u16Be : FormatOf Nat
+u16Be = Custom (MkCustomFormat
+  { Rep = Nat
+  , decode = map cast (decodeU16 BE)
+  , encode = encodeU16 BE . cast {to = Bits16}
+  })
+
+
+-----------------
+-- EXPERIMENTS --
+-----------------
+
+
+public export
+record Format where
+  constructor MkFormat
+  0 Rep : Type
+  Format : FormatOf Rep
+
+
+public export
+toFormatOf : (f : Format) -> FormatOf f.Rep
+toFormatOf (MkFormat _ f) = f
+
+
+either : (cond : Bool) -> FormatOf a -> FormatOf b -> FormatOf (if cond then a else b)
+either True f1 _ = f1
+either False _ f2 = f2
+
+orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf a
+orPure True f _ = f
+orPure False _ def = Pure def
+
+
+-- Reproduction of difficulties in OpenType format
+
+
+Flag : Type
+Flag = (flag : Nat ** repeat : Nat ** ())
+
+(.repeat) : Flag -> Nat
+(.repeat) (_ ** repeat ** _) = repeat
+
+
+-- def flag = {
+--     flag <- u8,
+--     repeat <- match ((u8_and flag 8) != (0 : U8)) {
+--       true => u8,
+--       false => succeed U8 0,
+--     },
+-- };
+flag : FormatOf Flag
+flag = do
+  flag <- u8
+  repeat <- case flag of
+    0 => u8
+    _ => Pure {A = Nat} 0
+  Pure ()
+
+
+SimpleGlyph : Type
+SimpleGlyph = (flag : Flag ** Nat)
+
+
+-- def simple_glyph = fun (number_of_contours : U16) => {
+--     ...
+--     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+--     ...
+-- };
+simple_glyph : FormatOf SimpleGlyph
+simple_glyph = do
+  flag <- flag
+  Pure (flag.repeat + 1)

From 7299eaa862f871aefc1bf2f2e45b8a08b78e3aba Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Wed, 31 Aug 2022 22:23:14 +1000
Subject: [PATCH 22/47] More work on styles of format description

---
 .../src/Fathom/Closed/IndexedInductive.idr    | 42 +++++++++++---
 .../Fathom/Closed/IndexedInductiveCustom.idr  | 58 ++++++++++++++-----
 .../src/Fathom/Closed/InductiveRecursive.idr  | 33 +++++++++--
 .../Closed/InductiveRecursiveCustom.idr       | 36 ++++++++++--
 experiments/idris/src/Fathom/Open/Record.idr  | 48 +++++++++++----
 experiments/idris/src/Playground.idr          | 40 +++++++++----
 6 files changed, 202 insertions(+), 55 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 2f2046fd0..30c11b2e0 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -11,9 +11,9 @@ import Fathom.Base
 import Fathom.Data.Sing
 
 
--------------------------
--- FORMAT DESCRIPTIONS --
--------------------------
+---------------------------------
+-- INDEXED FORMAT DESCRIPTIONS --
+---------------------------------
 
 
 ||| Universe of format descriptions indexed by their machine representations
@@ -77,16 +77,24 @@ encode (Bind f1 f2) (x ** y) =
   [| encode f1 x <+> encode (f2 x) y |]
 
 
------------------
--- EXPERIMENTS --
------------------
+-------------------------
+-- FORMAT DESCRIPTIONS --
+-------------------------
 
 
+||| A format description of an arbitrary representation
 public export
 record Format where
   constructor MkFormat
+  ||| The in-memory representation of the format description
   0 Rep : Type
-  Format : FormatOf Rep
+  ||| The underlying format description
+  format : FormatOf Rep
+
+
+------------------------------------
+-- FORMAT DESCRIPTION CONVERSIONS --
+------------------------------------
 
 
 public export
@@ -94,6 +102,26 @@ toFormatOf : (f : Format) -> FormatOf f.Rep
 toFormatOf (MkFormat _ f) = f
 
 
+public export
+toFormat : {0 A : Type} -> FormatOf A -> Format
+toFormat f = MkFormat A f
+
+
+public export
+toFormatOfEq : {0 A : Type} -> (f : Format ** f.Rep = A) -> FormatOf A
+toFormatOfEq (f ** prf) = rewrite sym prf in f.format
+
+
+public export
+toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** f.Rep = A)
+toFormatEq f = (MkFormat A f ** Refl)
+
+
+-----------------
+-- EXPERIMENTS --
+-----------------
+
+
 either : (cond : Bool) -> FormatOf a -> FormatOf b -> FormatOf (if cond then a else b)
 either True f1 _ = f1
 either False _ f2 = f2
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index 157cafac8..0d3bac483 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -10,9 +10,9 @@ import Data.Vect
 import Fathom.Base
 
 
--------------------------
--- FORMAT DESCRIPTIONS --
--------------------------
+---------------------------------
+-- INDEXED FORMAT DESCRIPTIONS --
+---------------------------------
 
 
 ||| A custom format description.
@@ -92,6 +92,46 @@ encode (Bind f1 f2) (x ** y) =
 encode (Custom f) x = f.encode x
 
 
+-------------------------
+-- FORMAT DESCRIPTIONS --
+-------------------------
+
+
+||| A format description of an arbitrary representation
+public export
+record Format where
+  constructor MkFormat
+  ||| The in-memory representation of the format description
+  0 Rep : Type
+  ||| The underlying format description
+  format : FormatOf Rep
+
+
+------------------------------------
+-- FORMAT DESCRIPTION CONVERSIONS --
+------------------------------------
+
+
+public export
+toFormatOf : (f : Format) -> FormatOf f.Rep
+toFormatOf (MkFormat _ f) = f
+
+
+public export
+toFormat : {0 A : Type} -> FormatOf A -> Format
+toFormat f = MkFormat A f
+
+
+public export
+toFormatOfEq : {0 A : Type} -> (f : Format ** f.Rep = A) -> FormatOf A
+toFormatOfEq (f ** prf) = rewrite sym prf in f.format
+
+
+public export
+toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** f.Rep = A)
+toFormatEq f = (MkFormat A f ** Refl)
+
+
 --------------------
 -- CUSTOM FORMATS --
 --------------------
@@ -129,18 +169,6 @@ u16Be = Custom (MkCustomFormat
 -----------------
 
 
-public export
-record Format where
-  constructor MkFormat
-  0 Rep : Type
-  Format : FormatOf Rep
-
-
-public export
-toFormatOf : (f : Format) -> FormatOf f.Rep
-toFormatOf (MkFormat _ f) = f
-
-
 either : (cond : Bool) -> FormatOf a -> FormatOf b -> FormatOf (if cond then a else b)
 either True f1 _ = f1
 either False _ f2 = f2
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 9fc97755e..a75e07325 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -57,7 +57,7 @@ mutual
     -- Custom : (f : Record.Format) -> Format
 
 
-  ||| In-memory representation of format descriptions
+  ||| The in-memory representation of format descriptions
   public export
   Rep : Format -> Type
   Rep End = Unit
@@ -127,9 +127,9 @@ encode (Bind f1 f2) (x ** y) = do
   [| encode f1 x <+> encode (f2 x) y |]
 
 
------------------
--- EXPERIMENTS --
------------------
+---------------------------------
+-- INDEXED FORMAT DESCRIPTIONS --
+---------------------------------
 
 
 ||| A format description refined with a fixed representation
@@ -138,6 +138,31 @@ data FormatOf : (0 A : Type) -> Type where
   MkFormatOf : (f : Format) -> FormatOf (Rep f)
 
 
+------------------------------------
+-- FORMAT DESCRIPTION CONVERSIONS --
+------------------------------------
+
+
+public export
+toFormatOf : (f : Format) -> FormatOf (Rep f)
+toFormatOf f = MkFormatOf f
+
+
+public export
+toFormat : {0 A : Type} -> FormatOf A -> Format
+toFormat (MkFormatOf f) = f
+
+
+public export
+toFormatOfEq : {0 A : Type} -> (f : Format ** Rep f = A) -> FormatOf A
+toFormatOfEq (f ** prf) = rewrite sym prf in MkFormatOf f
+
+
+public export
+toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** Rep f = A)
+toFormatEq (MkFormatOf f) = (f ** Refl)
+
+
 export
 either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
 either True f1 _ = MkFormatOf f1
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 18456bc6c..661d29200 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -45,7 +45,7 @@ mutual
     Custom :  (f : CustomFormat) -> Format
 
 
-  ||| In-memory representation of format descriptions
+  ||| The in-memory representation of format descriptions
   public export
   Rep : Format -> Type
   Rep End = Unit
@@ -145,21 +145,47 @@ u16Be = Custom (MkCustomFormat
   })
 
 
------------------
--- EXPERIMENTS --
------------------
+---------------------------------
+-- INDEXED FORMAT DESCRIPTIONS --
+---------------------------------
 
 
-||| A format description refined with a fixed representation
+||| A format description indexed with a fixed representation
 public export
 data FormatOf : (0 Rep : Type) -> Type where
   MkFormatOf : (f : Format) -> FormatOf (Rep f)
 
 
+------------------------------------
+-- FORMAT DESCRIPTION CONVERSIONS --
+------------------------------------
+
+
+public export
 toFormatOf : (f : Format) -> FormatOf (Rep f)
 toFormatOf f = MkFormatOf f
 
 
+public export
+toFormat : {0 A : Type} -> FormatOf A -> Format
+toFormat (MkFormatOf f) = f
+
+
+public export
+toFormatOfEq : {0 A : Type} -> (f : Format ** Rep f = A) -> FormatOf A
+toFormatOfEq (f ** prf) = rewrite sym prf in MkFormatOf f
+
+
+public export
+toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** Rep f = A)
+toFormatEq (MkFormatOf f) = (f ** Refl)
+
+
+-----------------
+-- EXPERIMENTS --
+-----------------
+
+
 export
 either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
 either True f1 _ = MkFormatOf f1
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index e93750939..3231cc00a 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -31,6 +31,42 @@ record Format where
   encode : Encode Rep ByteStream
 
 
+---------------------------------
+-- INDEXED FORMAT DESCRIPTIONS --
+---------------------------------
+
+
+||| A format description refined with a fixed representation
+public export
+data FormatOf : (0 A : Type) -> Type where
+  MkFormatOf : (f : Format) -> FormatOf f.Rep
+
+
+------------------------------------
+-- FORMAT DESCRIPTION CONVERSIONS --
+------------------------------------
+
+
+public export
+toFormatOf : (f : Format) -> FormatOf f.Rep
+toFormatOf f = MkFormatOf f
+
+
+public export
+toFormat : {0 A : Type} -> FormatOf A -> Format
+toFormat (MkFormatOf f) = f
+
+
+public export
+toFormatOfEq : {0 A : Type} -> (f : Format ** f.Rep = A) -> FormatOf A
+toFormatOfEq (f ** prf) = rewrite sym prf in MkFormatOf f
+
+
+public export
+toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** f.Rep = A)
+toFormatEq (MkFormatOf f) = (f ** Refl)
+
+
 --------------
 -- FORMATS --
 --------------
@@ -168,15 +204,3 @@ u16Be = MkFormat
   , decode = decodeU16 BE
   , encode = encodeU16 BE
   }
-
-
-
------------------
--- EXPERIMENTS --
------------------
-
-
-||| A format description refined with a fixed representation
-public export
-data FormatOf : (0 A : Type) -> Type where
-  MkFormatOf : (f : Format) -> FormatOf f.Rep
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index 9d3b777a0..67d516d61 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -73,15 +73,31 @@ indRecToIndexed (Repeat len f) = Indexed.Repeat len (indRecToIndexed f)
 indRecToIndexed (Bind f g) = Indexed.Bind (indRecToIndexed f) (\x => indRecToIndexed (g x))
 
 
-||| Convert an indexed format description to an inductive-recursive format
-indexedToIndRec : {0 A : Type} -> (f : Indexed.FormatOf A) -> IndRec.FormatOf A
-indexedToIndRec End = MkFormatOf IndRec.End
-indexedToIndRec Fail = MkFormatOf IndRec.Fail
-indexedToIndRec (Pure x) = MkFormatOf (IndRec.Pure x)
-indexedToIndRec (Skip f def) with (indexedToIndRec f)
-  indexedToIndRec (Skip _ def) | MkFormatOf f = MkFormatOf (IndRec.Skip f def)
-indexedToIndRec (Repeat len f) with (indexedToIndRec f)
-  indexedToIndRec (Repeat len _) | MkFormatOf f = MkFormatOf (IndRec.Repeat len f)
-indexedToIndRec (Bind f1 f2) with (indexedToIndRec f1)
-  indexedToIndRec (Bind _ f2) | MkFormatOf f1 =
-    ?todo_indexedToIndRec
+mutual
+
+  ||| Convert an indexed format description to an inductive-recursive format
+  indexedToIndRecFormat : (f : Indexed.Format) -> (f' : IndRec.Format ** Rep f = Rep f')
+  indexedToIndRecFormat (MkFormat () End) = (End ** Refl)
+  indexedToIndRecFormat (MkFormat Void Fail) = (Fail ** Refl)
+  indexedToIndRecFormat (MkFormat (Sing x) (Pure x)) = (Pure x ** Refl)
+  indexedToIndRecFormat (MkFormat () (Skip f def)) with (indexedToIndRecFormatOf f)
+    _ | MkFormatOf f' = (Skip f' def ** Refl)
+  indexedToIndRecFormat (MkFormat (Vect len _) (Repeat len f)) with (indexedToIndRecFormatOf f)
+    _ | MkFormatOf f' = (Repeat len f' ** Refl)
+  indexedToIndRecFormat (MkFormat (x : _ ** _) (Bind f1 f2)) with (indexedToIndRecFormatOf f1)
+    _ | MkFormatOf f1' =
+      (Bind f1' (\x => ?indexedToIndRecFormatBind_f2) ** ?todoBindPrf)
+
+
+  ||| Convert an indexed format description to an inductive-recursive format
+  indexedToIndRecFormatOf : {0 A : Type} -> (f : Indexed.FormatOf A) -> IndRec.FormatOf A
+  indexedToIndRecFormatOf End = MkFormatOf End
+  indexedToIndRecFormatOf Fail = MkFormatOf Fail
+  indexedToIndRecFormatOf (Pure x) = MkFormatOf (Pure x)
+  indexedToIndRecFormatOf (Skip f def) with (indexedToIndRecFormatOf f)
+    _ | MkFormatOf f' = MkFormatOf (Skip f' def)
+  indexedToIndRecFormatOf (Repeat len f) with (indexedToIndRecFormatOf f)
+    _ | MkFormatOf f' = MkFormatOf (Repeat len f')
+  indexedToIndRecFormatOf (Bind f1 f2) with (indexedToIndRecFormatOf f1)
+    _ | MkFormatOf f1' =
+      ?indexedToIndRecFormatOfBind

From 6ea96ed2f3944e7d2a5b365a0ac253b3711297b4 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 1 Sep 2022 10:05:19 +1000
Subject: [PATCH 23/47] Define isomorphisms between Formats and FormatOfs

---
 experiments/idris/fathom.ipkg                 |  1 +
 .../src/Fathom/Closed/IndexedInductive.idr    | 51 +++++++++-
 .../Fathom/Closed/IndexedInductiveCustom.idr  | 28 +++++-
 .../src/Fathom/Closed/InductiveRecursive.idr  | 26 +++++-
 .../Closed/InductiveRecursiveCustom.idr       | 93 +++++++++++--------
 experiments/idris/src/Fathom/Data/Iso.idr     | 50 ++++++++++
 6 files changed, 207 insertions(+), 42 deletions(-)
 create mode 100644 experiments/idris/src/Fathom/Data/Iso.idr

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index 9031ab6ce..171ffcf34 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -16,6 +16,7 @@ package fathom
 modules = Fathom
         , Fathom.Base
         , Fathom.Data.Bit
+        , Fathom.Data.Iso
         , Fathom.Data.Sing
         , Fathom.Data.Refine
         , Fathom.Data.Word
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 30c11b2e0..7be49f6ee 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -5,9 +5,11 @@ module Fathom.Closed.IndexedInductive
 
 
 import Data.Colist
+import Data.DPair
 import Data.Vect
 
 import Fathom.Base
+import Fathom.Data.Iso
 import Fathom.Data.Sing
 
 
@@ -18,7 +20,7 @@ import Fathom.Data.Sing
 
 ||| Universe of format descriptions indexed by their machine representations
 public export
-data FormatOf : (0 A : Type) -> Type where
+data FormatOf : Type -> Type where
   End : FormatOf Unit
   Fail : FormatOf Void
   Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
@@ -64,6 +66,29 @@ decode (Bind f1 f2) buffer = do
   (y, buffer'') <- decode (f2 x) buffer'
   Just ((x ** y), buffer'')
 
+-- export
+-- decode : {0 A, S : Type} -> (f : FormatOf A) -> Decode (A, Colist S) (Colist S)
+-- decode End
+--   = \buffer => case buffer of
+--       [] => Just ((), [])
+--       _::_ => Nothing
+-- decode Fail
+--   = const Nothing
+-- decode (Pure x)
+--   = pure (MkSing x)
+-- decode (Skip f _)
+--   = do  _ <- decode f
+--         pure ()
+-- decode (Repeat 0 f) = pure []
+-- decode (Repeat (S len) f)
+--   = do  x <- decode f
+--         xs <- decode (Repeat len f)
+--         pure (x :: xs)
+-- decode (Bind f1 f2)
+--   = do  x <- decode f1
+--         y <- decode (f2 x)
+--         pure (x ** y)
+
 
 export
 encode : {0 A, S : Type} -> (f : FormatOf A) -> Encode A (Colist S)
@@ -107,16 +132,40 @@ toFormat : {0 A : Type} -> FormatOf A -> Format
 toFormat f = MkFormat A f
 
 
+public export
+toFormatOfIso : Iso Format (Exists FormatOf)
+toFormatOfIso = MkIso
+  { to = \f => Evidence _ (toFormatOf f)
+  , from = \(Evidence _ f) => toFormat f
+  , toFrom = \(Evidence _ _) => Refl
+  , fromTo = \(MkFormat _ _) => Refl
+  }
+
+
+||| Convert a format description into an indexed format description with an
+||| equality proof that the representation is the same as the index.
 public export
 toFormatOfEq : {0 A : Type} -> (f : Format ** f.Rep = A) -> FormatOf A
 toFormatOfEq (f ** prf) = rewrite sym prf in f.format
 
 
+||| Convert an indexed format description to a existential format description,
+||| along with a proof that the representation is the same as the index.
 public export
 toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** f.Rep = A)
 toFormatEq f = (MkFormat A f ** Refl)
 
 
+public export
+toFormatOfEqIso : Iso (Exists (\a => (f : Format ** f.Rep = a))) (Exists FormatOf)
+toFormatOfEqIso = MkIso
+  { to = \(Evidence _f) => Evidence _ (toFormatOfEq f)
+  , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
+  , toFrom = \(Evidence _ _) => Refl
+  , fromTo = \(Evidence _ ((MkFormat _ _) ** Refl)) => Refl
+  }
+
+
 -----------------
 -- EXPERIMENTS --
 -----------------
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index 0d3bac483..e09141342 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -5,9 +5,11 @@ module Fathom.Closed.IndexedInductiveCustom
 
 
 import Data.Colist
+import Data.DPair
 import Data.Vect
 
 import Fathom.Base
+import Fathom.Data.Iso
 
 
 ---------------------------------
@@ -30,7 +32,7 @@ record CustomFormat where
 
 ||| Universe of format descriptions indexed by their machine representations
 public export
-data FormatOf : (0 A : Type) -> Type where
+data FormatOf : (A : Type) -> Type where
   End : FormatOf Unit
   Fail : FormatOf Void
   Pure : {0 A : Type} -> (x : A) -> FormatOf A
@@ -122,16 +124,40 @@ toFormat : {0 A : Type} -> FormatOf A -> Format
 toFormat f = MkFormat A f
 
 
+public export
+toFormatOfIso : Iso Format (Exists FormatOf)
+toFormatOfIso = MkIso
+  { to = \f => Evidence _ (toFormatOf f)
+  , from = \(Evidence _ f) => toFormat f
+  , toFrom = \(Evidence _ _) => Refl
+  , fromTo = \(MkFormat _ _) => Refl
+  }
+
+
+||| Convert a format description into an indexed format description with an
+||| equality proof that the representation is the same as the index.
 public export
 toFormatOfEq : {0 A : Type} -> (f : Format ** f.Rep = A) -> FormatOf A
 toFormatOfEq (f ** prf) = rewrite sym prf in f.format
 
 
+||| Convert an indexed format description to a existential format description,
+||| along with a proof that the representation is the same as the index.
 public export
 toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** f.Rep = A)
 toFormatEq f = (MkFormat A f ** Refl)
 
 
+public export
+toFormatOfEqIso : Iso (Exists (\a => (f : Format ** f.Rep = a))) (Exists FormatOf)
+toFormatOfEqIso = MkIso
+  { to = \(Evidence _f) => Evidence _ (toFormatOfEq f)
+  , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
+  , toFrom = \(Evidence _ _) => Refl
+  , fromTo = \(Evidence _ ((MkFormat _ _) ** Refl)) => Refl
+  }
+
+
 --------------------
 -- CUSTOM FORMATS --
 --------------------
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index a75e07325..8609c4736 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -23,9 +23,11 @@ module Fathom.Closed.InductiveRecursive
 
 
 import Data.Colist
+import Data.DPair
 import Data.Vect
 
 import Fathom.Base
+import Fathom.Data.Iso
 import Fathom.Data.Sing
 
 -- import Fathom.Open.Record
@@ -134,7 +136,7 @@ encode (Bind f1 f2) (x ** y) = do
 
 ||| A format description refined with a fixed representation
 public export
-data FormatOf : (0 A : Type) -> Type where
+data FormatOf : (A : Type) -> Type where
   MkFormatOf : (f : Format) -> FormatOf (Rep f)
 
 
@@ -153,16 +155,38 @@ toFormat : {0 A : Type} -> FormatOf A -> Format
 toFormat (MkFormatOf f) = f
 
 
+public export
+toFormatOfIso : Iso Format (Exists FormatOf)
+toFormatOfIso = MkIso
+  { to = \f => Evidence _ (toFormatOf f)
+  , from = \(Evidence _ f) => toFormat f
+  , toFrom = \(Evidence _ (MkFormatOf _)) => Refl
+  , fromTo = \_ => Refl
+  }
+
+
+||| Convert a format description into an indexed format description with an
+||| equality proof that the representation is the same as the index.
 public export
 toFormatOfEq : {0 A : Type} -> (f : Format ** Rep f = A) -> FormatOf A
 toFormatOfEq (f ** prf) = rewrite sym prf in MkFormatOf f
 
 
+||| Convert an indexed format description to a existential format description,
+||| along with a proof that the representation is the same as the index.
 public export
 toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** Rep f = A)
 toFormatEq (MkFormatOf f) = (f ** Refl)
 
 
+public export
+toFormatOfEqIso : Iso (Exists (\a => (f : Format ** Rep f = a))) (Exists FormatOf)
+toFormatOfEqIso = MkIso
+  { to = \(Evidence _ f) => Evidence _ (toFormatOfEq f)
+  , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
+  , toFrom = \(Evidence _ (MkFormatOf _)) => Refl
+  , fromTo = \(Evidence _ (f ** Refl)) => Refl
+  }
 export
 either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
 either True f1 _ = MkFormatOf f1
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 661d29200..62e3d0651 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -6,14 +6,19 @@ module Fathom.Closed.InductiveRecursiveCustom
 
 import Data.Bits
 import Data.Colist
-import Data.Vect
 import Data.DPair
+import Data.Vect
 
 import Fathom.Base
-import Fathom.Data.Sing
+import Fathom.Data.Iso
 import Fathom.Data.Refine
 
 
+public export
+typeOf : {1 A : Type} -> (0 x : A) -> Type
+typeOf _ = A
+
+
 -------------------------
 -- FORMAT DESCRIPTIONS --
 -------------------------
@@ -38,7 +43,7 @@ mutual
   data Format : Type where
     End : Format
     Fail : Format
-    Pure : {0 A : Type} -> A -> Format
+    Pure : {A : Type} -> A -> Format
     Skip : (f : Format) -> (def : Rep f) -> Format
     Repeat : Nat -> Format -> Format
     Bind : (f : Format) -> (Rep f -> Format) -> Format
@@ -52,7 +57,7 @@ mutual
   Rep Fail = Void
   Rep (Skip _ _) = Unit
   Rep (Repeat len f) = Vect len (Rep f)
-  Rep (Pure x) = Sing x
+  Rep (Pure x) = typeOf x
   Rep (Bind f1 f2) = (x : Rep f1 ** Rep (f2 x))
   Rep (Custom f) = f.Rep
 
@@ -68,7 +73,7 @@ decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
 decode (Pure x) buffer =
-  Just (MkSing x, buffer)
+  Just (x, buffer)
 decode (Skip f _) buffer = do
   (x, buffer') <- decode f buffer
   Just ((), buffer')
@@ -88,7 +93,7 @@ decode (Custom f) buffer = f.decode buffer
 export
 encode : (f : Format) -> Encode (Rep f) ByteStream
 encode End () = Just []
-encode (Pure x) (MkSing _) = Just []
+encode (Pure x) _ = Just []
 encode (Skip f def) () = encode f def
 encode (Repeat Z f) [] = Just []
 encode (Repeat (S len) f) (x :: xs) =
@@ -105,7 +110,7 @@ encode (Custom f) x = f.encode x
 -- Support for do notation
 
 public export
-pure : {0 A : Type} -> A -> Format
+pure : {A : Type} -> A -> Format
 pure = Pure
 
 public export
@@ -121,27 +126,27 @@ public export
 public export
 u8 : Format
 u8 = Custom (MkCustomFormat
-  { Rep = Bits8
-  , decode = decodeU8
-  , encode = encodeU8
+  { Rep = Nat
+  , decode = map cast decodeU8
+  , encode = encodeU8 . cast {to = Bits8}
   })
 
 
 public export
 u16Le : Format
 u16Le = Custom (MkCustomFormat
-  { Rep = Bits16
-  , decode = decodeU16 LE
-  , encode = encodeU16 LE
+  { Rep = Nat
+  , decode = map cast (decodeU16 LE)
+  , encode = encodeU16 LE . cast {to = Bits16}
   })
 
 
 public export
 u16Be : Format
 u16Be = Custom (MkCustomFormat
-  { Rep = Bits16
-  , decode = decodeU16 BE
-  , encode = encodeU16 BE
+  { Rep = Nat
+  , decode = map cast (decodeU16 BE)
+  , encode = encodeU16 BE . cast {to = Bits16}
   })
 
 
@@ -152,7 +157,7 @@ u16Be = Custom (MkCustomFormat
 
 ||| A format description indexed with a fixed representation
 public export
-data FormatOf : (0 Rep : Type) -> Type where
+data FormatOf : (Rep : Type) -> Type where
   MkFormatOf : (f : Format) -> FormatOf (Rep f)
 
 
@@ -171,16 +176,40 @@ toFormat : {0 A : Type} -> FormatOf A -> Format
 toFormat (MkFormatOf f) = f
 
 
+public export
+toFormatOfIso : Iso Format (Exists FormatOf)
+toFormatOfIso = MkIso
+  { to = \f => Evidence _ (toFormatOf f)
+  , from = \(Evidence _ f) => toFormat f
+  , toFrom = \(Evidence _ (MkFormatOf _)) => Refl
+  , fromTo = \_ => Refl
+  }
+
+
+||| Convert a format description into an indexed format description with an
+||| equality proof that the representation is the same as the index.
 public export
 toFormatOfEq : {0 A : Type} -> (f : Format ** Rep f = A) -> FormatOf A
 toFormatOfEq (f ** prf) = rewrite sym prf in MkFormatOf f
 
 
+||| Convert an indexed format description to a existential format description,
+||| along with a proof that the representation is the same as the index.
 public export
 toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** Rep f = A)
 toFormatEq (MkFormatOf f) = (f ** Refl)
 
 
+public export
+toFormatOfEqIso : Iso (Exists (\a => (f : Format ** Rep f = a))) (Exists FormatOf)
+toFormatOfEqIso = MkIso
+  { to = \(Evidence _f) => Evidence _ (toFormatOfEq f)
+  , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
+  , toFrom = \(Evidence _ (MkFormatOf _)) => Refl
+  , fromTo = \(Evidence _ (_ ** Refl)) => Refl
+  }
+
+
 -----------------
 -- EXPERIMENTS --
 -----------------
@@ -193,13 +222,13 @@ either False _ f2 = MkFormatOf f2
 
 
 export
-orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
+orPure : {A : Type} -> (cond : Bool) -> FormatOf A -> (def : A) -> FormatOf A
 orPure True f _ = f
 orPure False _ def = MkFormatOf (Pure def)
 
 
 export
-orPure' : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
+orPure' : {A : Type} -> (cond : Bool) -> FormatOf A -> (def : A) -> FormatOf A
 orPure' True f _ = f
 orPure' False _ def = MkFormatOf (Pure def)
 
@@ -216,8 +245,9 @@ orPure' False _ def = MkFormatOf (Pure def)
 flag : Format
 flag = do
   flag <- u8
-  repeat <- if flag == 0 then u8 else
-    Pure {A = Bits8} 0
+  repeat <- case flag of
+    0 => u8
+    _ => Pure {A = Nat} 0
   Pure ()
 
 -- def simple_glyph = fun (number_of_contours : U16) => {
@@ -227,25 +257,10 @@ flag = do
 -- };
 simple_glyph : Format
 simple_glyph = do
-  (flag ** repeat ** MkSing ()) <- flag
+  (flag ** repeat ** ()) <- flag
   let
-    repeat' : Bits8
+    repeat' : Nat
     repeat' = case flag of
       0 => repeat
-      x => ?todo4
-
-    -- repeat' : Bits8
-    -- repeat' with (flag)
-    --   repeat' | 0 = ?todo3
-    --   repeat' | x = ?todo4
-
-    -- repeat' : Bits8
-    -- repeat' with (MkSingEq flag)
-    --   repeat' | MkSingEq 0 {prf} = ?help
-    --   repeat' | MkSingEq x {prf} = ?todo4
-
-    -- repeat' : Bits8
-    -- repeat' = case MkSingEq flag of
-    --   MkSingEq 0 {prf} => ?todo3
-    --   MkSingEq x {prf} => ?todo4
+      repeat => ?todo_repeat
   Pure (repeat' + 1)
diff --git a/experiments/idris/src/Fathom/Data/Iso.idr b/experiments/idris/src/Fathom/Data/Iso.idr
new file mode 100644
index 000000000..fd68090e5
--- /dev/null
+++ b/experiments/idris/src/Fathom/Data/Iso.idr
@@ -0,0 +1,50 @@
+||| Isomorphisms between types
+
+module Fathom.Data.Iso
+
+
+||| A datatype that forms a proof that two types are isomorphic to each other,
+||| ie. can be converted to and from each other while preserving information.
+public export
+record Iso (0 A : Type) (0 B : Type) where
+  constructor MkIso
+  to : A -> B
+  from : B -> A
+  0 toFrom : (y : B) -> to (from y) = y
+  0 fromTo : (x : A) -> from (to x) = x
+
+
+sym : Iso a b -> Iso b a
+sym iso = MkIso
+  { to = iso.from
+  , from = iso.to
+  , toFrom = iso.fromTo
+  , fromTo = iso.toFrom
+  }
+
+
+isoSym : Iso (Iso a b) (Iso b a)
+isoSym = MkIso
+  { to = sym
+  , from = sym
+  , toFrom = \(MkIso _ _ _ _) => Refl
+  , fromTo = \(MkIso _ _ _ _) => Refl
+  }
+
+
+cong : (f : Type -> Type) -> Iso a b -> Iso (f a) (f b)
+cong f iso = MkIso
+  { to = \fa => ?todo_to
+  , from = \fb => ?todo_from
+  , toFrom = ?todo_toFrom
+  , fromTo = ?todo_fromTo
+  }
+
+
+trans : Iso a b -> Iso b c -> Iso a c
+trans isoAB isoBC = MkIso
+  { to = isoBC.to . isoAB.to
+  , from = isoAB.from . isoBC.from
+  , toFrom = \c => trans ?todo_toFrom1' (isoBC.toFrom c)
+  , fromTo = \c => ?todo_fromTo'
+  }

From b5b4439c38feff0e448eade137e1cc3e4133c260 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 1 Sep 2022 11:54:43 +1000
Subject: [PATCH 24/47] Get OpenType examples to work for all approaches

---
 .../src/Fathom/Closed/IndexedInductive.idr    | 14 -----
 .../Fathom/Closed/IndexedInductiveCustom.idr  | 38 ++++++------
 .../src/Fathom/Closed/InductiveRecursive.idr  | 34 -----------
 .../Closed/InductiveRecursiveCustom.idr       | 49 +++++-----------
 experiments/idris/src/Fathom/Open/Record.idr  | 58 ++++++++++++++++---
 experiments/idris/src/Playground.idr          | 22 +++++++
 6 files changed, 107 insertions(+), 108 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 7be49f6ee..8346549ea 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -164,17 +164,3 @@ toFormatOfEqIso = MkIso
   , toFrom = \(Evidence _ _) => Refl
   , fromTo = \(Evidence _ ((MkFormat _ _) ** Refl)) => Refl
   }
-
-
------------------
--- EXPERIMENTS --
------------------
-
-
-either : (cond : Bool) -> FormatOf a -> FormatOf b -> FormatOf (if cond then a else b)
-either True f1 _ = f1
-either False _ f2 = f2
-
-orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
-orPure True f _ = f
-orPure False _ def = Pure def
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index e09141342..ac3fbc7e5 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -10,6 +10,7 @@ import Data.Vect
 
 import Fathom.Base
 import Fathom.Data.Iso
+import Fathom.Data.Sing
 
 
 ---------------------------------
@@ -35,7 +36,7 @@ public export
 data FormatOf : (A : Type) -> Type where
   End : FormatOf Unit
   Fail : FormatOf Void
-  Pure : {0 A : Type} -> (x : A) -> FormatOf A
+  Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
   Skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
   Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
   Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
@@ -45,7 +46,7 @@ data FormatOf : (A : Type) -> Type where
 -- Support for do notation
 
 public export
-pure : {0 A : Type} -> (x : A) -> FormatOf A
+pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
 pure = Pure
 
 public export
@@ -64,7 +65,7 @@ decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
 decode (Pure x) buffer =
-  Just (x, buffer)
+  Just (MkSing x, buffer)
 decode (Skip f _) buffer = do
   (x, buffer') <- decode f buffer
   Just ((), buffer')
@@ -84,7 +85,7 @@ decode (Custom f) buffer = f.decode buffer
 export
 encode : {0 A : Type} -> (f : FormatOf A) -> Encode A (ByteStream)
 encode End () = Just []
-encode (Pure x) _ = Just []
+encode (Pure x) (MkSing _) = Just []
 encode (Skip f def) () = encode f def
 encode (Repeat Z f) [] = Just []
 encode (Repeat (S len) f) (x :: xs) =
@@ -194,24 +195,22 @@ u16Be = Custom (MkCustomFormat
 -- EXPERIMENTS --
 -----------------
 
-
-either : (cond : Bool) -> FormatOf a -> FormatOf b -> FormatOf (if cond then a else b)
-either True f1 _ = f1
-either False _ f2 = f2
-
-orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf a
-orPure True f _ = f
-orPure False _ def = Pure def
-
-
 -- Reproduction of difficulties in OpenType format
 
 
 Flag : Type
-Flag = (flag : Nat ** repeat : Nat ** ())
+Flag =
+  (  id : Nat
+  ** repeat :
+    case id of
+      0 => Nat
+      S n => Sing {A = Nat} 0
+  ** Sing ()
+  )
 
 (.repeat) : Flag -> Nat
-(.repeat) (_ ** repeat ** _) = repeat
+(.repeat) (0 ** repeat ** _) = repeat
+(.repeat) (S _ ** repeat ** _) = val repeat
 
 
 -- def flag = {
@@ -226,12 +225,15 @@ flag = do
   flag <- u8
   repeat <- case flag of
     0 => u8
-    _ => Pure {A = Nat} 0
+    S _ => Pure {A = Nat} 0
   Pure ()
 
 
 SimpleGlyph : Type
-SimpleGlyph = (flag : Flag ** Nat)
+SimpleGlyph =
+  (  flag : Flag
+  ** Sing (flag.repeat + 1)
+  )
 
 
 -- def simple_glyph = fun (number_of_contours : U16) => {
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 8609c4736..908751bda 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -49,15 +49,6 @@ mutual
     Repeat : Nat -> Format -> Format
     Bind : (f : Format) -> (Rep f -> Format) -> Format
 
-    -- Questionable format descriptions
-    -- OrPure : (cond : Bool) -> (f : Format) -> (def : Rep f) -> Format
-    -- OfSing : (f : Format) -> Sing (Rep f) -> Format
-    -- OfEq : (f : Format) -> (r : Type) -> {auto 0 prf : Rep f = r} -> Format
-
-    -- Broken stuff
-    -- Let : (f : Format) -> (Rep f -> Format) -> Format
-    -- Custom : (f : Record.Format) -> Format
-
 
   ||| The in-memory representation of format descriptions
   public export
@@ -69,15 +60,6 @@ mutual
   Rep (Pure x) = Sing x
   Rep (Bind f1 f2) = (x : Rep f1 ** Rep (f2 x))
 
-  -- Questionable format descriptions
-  -- Rep (OrPure _ f _) = Rep f
-  -- Rep (OfSing f r) = value r
-  -- Rep (OfEq f r) = r
-
-  -- Broken stuff
-  -- Rep (Let f1 f2) = Rep (f2 ?halp)
-  -- Rep (Custom f) = f.Rep
-
 
 -- Support for do notation
 
@@ -187,19 +169,3 @@ toFormatOfEqIso = MkIso
   , toFrom = \(Evidence _ (MkFormatOf _)) => Refl
   , fromTo = \(Evidence _ (f ** Refl)) => Refl
   }
-export
-either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
-either True f1 _ = MkFormatOf f1
-either False _ f2 = MkFormatOf f2
-
-
-public export
-orPure : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
-orPure True f _ = f
-orPure False _ def = MkFormatOf (Pure def)
-
-
-public export
-orPure' : (cond : Bool) -> FormatOf a -> (def : a) -> FormatOf (if cond then a else Sing def)
-orPure' True f _ = f
-orPure' False _ def = MkFormatOf (Pure def)
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 62e3d0651..433824acc 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -12,6 +12,7 @@ import Data.Vect
 import Fathom.Base
 import Fathom.Data.Iso
 import Fathom.Data.Refine
+import Fathom.Data.Sing
 
 
 public export
@@ -43,7 +44,7 @@ mutual
   data Format : Type where
     End : Format
     Fail : Format
-    Pure : {A : Type} -> A -> Format
+    Pure : {0 A : Type} -> A -> Format
     Skip : (f : Format) -> (def : Rep f) -> Format
     Repeat : Nat -> Format -> Format
     Bind : (f : Format) -> (Rep f -> Format) -> Format
@@ -57,7 +58,7 @@ mutual
   Rep Fail = Void
   Rep (Skip _ _) = Unit
   Rep (Repeat len f) = Vect len (Rep f)
-  Rep (Pure x) = typeOf x
+  Rep (Pure x) = Sing x
   Rep (Bind f1 f2) = (x : Rep f1 ** Rep (f2 x))
   Rep (Custom f) = f.Rep
 
@@ -73,7 +74,7 @@ decode End [] = Just ((), [])
 decode End (_::_) = Nothing
 decode Fail _ = Nothing
 decode (Pure x) buffer =
-  Just (x, buffer)
+  Just (MkSing x, buffer)
 decode (Skip f _) buffer = do
   (x, buffer') <- decode f buffer
   Just ((), buffer')
@@ -93,7 +94,7 @@ decode (Custom f) buffer = f.decode buffer
 export
 encode : (f : Format) -> Encode (Rep f) ByteStream
 encode End () = Just []
-encode (Pure x) _ = Just []
+encode (Pure x) (MkSing _) = Just []
 encode (Skip f def) () = encode f def
 encode (Repeat Z f) [] = Just []
 encode (Repeat (S len) f) (x :: xs) =
@@ -110,7 +111,7 @@ encode (Custom f) x = f.encode x
 -- Support for do notation
 
 public export
-pure : {A : Type} -> A -> Format
+pure : {0 A : Type} -> A -> Format
 pure = Pure
 
 public export
@@ -214,25 +215,6 @@ toFormatOfEqIso = MkIso
 -- EXPERIMENTS --
 -----------------
 
-
-export
-either : (cond : Bool) -> (f1 : Format) -> (f2 : Format) -> FormatOf (if cond then Rep f1 else Rep f2)
-either True f1 _ = MkFormatOf f1
-either False _ f2 = MkFormatOf f2
-
-
-export
-orPure : {A : Type} -> (cond : Bool) -> FormatOf A -> (def : A) -> FormatOf A
-orPure True f _ = f
-orPure False _ def = MkFormatOf (Pure def)
-
-
-export
-orPure' : {A : Type} -> (cond : Bool) -> FormatOf A -> (def : A) -> FormatOf A
-orPure' True f _ = f
-orPure' False _ def = MkFormatOf (Pure def)
-
-
 -- Reproduction of difficulties in OpenType format
 
 -- def flag = {
@@ -244,12 +226,13 @@ orPure' False _ def = MkFormatOf (Pure def)
 -- };
 flag : Format
 flag = do
-  flag <- u8
-  repeat <- case flag of
+  id <- u8
+  repeat <- case id of
     0 => u8
-    _ => Pure {A = Nat} 0
+    S n => Pure {A = Nat} 0
   Pure ()
 
+
 -- def simple_glyph = fun (number_of_contours : U16) => {
 --     ...
 --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
@@ -257,10 +240,10 @@ flag = do
 -- };
 simple_glyph : Format
 simple_glyph = do
-  (flag ** repeat ** ()) <- flag
+  flag <- flag
   let
-    repeat' : Nat
-    repeat' = case flag of
-      0 => repeat
-      repeat => ?todo_repeat
-  Pure (repeat' + 1)
+    repeat : Nat
+    repeat = case flag of
+      (0 ** repeat ** MkSing ()) => repeat
+      (S n ** repeat ** MkSing ()) => repeat
+  Pure (repeat + 1)
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index 3231cc00a..4b457a0cd 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -182,25 +182,65 @@ public export
 public export
 u8 : Format
 u8 = MkFormat
-  { Rep = Bits8
-  , decode = decodeU8
-  , encode = encodeU8
+  { Rep = Nat
+  , decode = map cast decodeU8
+  , encode = encodeU8 . cast {to = Bits8}
   }
 
 
 public export
 u16Le : Format
 u16Le = MkFormat
-  { Rep = Bits16
-  , decode = decodeU16 LE
-  , encode = encodeU16 LE
+  { Rep = Nat
+  , decode = map cast (decodeU16 LE)
+  , encode = encodeU16 LE . cast {to = Bits16}
   }
 
 
 public export
 u16Be : Format
 u16Be = MkFormat
-  { Rep = Bits16
-  , decode = decodeU16 BE
-  , encode = encodeU16 BE
+  { Rep = Nat
+  , decode = map cast (decodeU16 BE)
+  , encode = encodeU16 BE . cast {to = Bits16}
   }
+
+
+-----------------
+-- EXPERIMENTS --
+-----------------
+
+
+-- Reproduction of difficulties in OpenType format
+
+
+-- def flag = {
+--     flag <- u8,
+--     repeat <- match ((u8_and flag 8) != (0 : U8)) {
+--       true => u8,
+--       false => succeed U8 0,
+--     },
+-- };
+flag : Format
+flag = do
+  id <- u8
+  repeat <- case id of
+    0 => u8
+    S _ => pure {A = Nat} 0
+  pure ()
+
+
+(.repeat) : Record.flag.Rep -> Nat
+(.repeat) (0 ** repeat ** _) = repeat
+(.repeat) (S _ ** repeat ** _) = val repeat
+
+
+-- def simple_glyph = fun (number_of_contours : U16) => {
+--     ...
+--     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+--     ...
+-- };
+simple_glyph : Format
+simple_glyph = do
+  flag <- flag
+  pure (flag.repeat + 1)
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index 67d516d61..d339d3038 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -101,3 +101,25 @@ mutual
   indexedToIndRecFormatOf (Bind f1 f2) with (indexedToIndRecFormatOf f1)
     _ | MkFormatOf f1' =
       ?indexedToIndRecFormatOfBind
+
+
+-- Reproduction of difficulties in OpenType format, drawing parallels to
+-- Tarski-style universes.
+
+repeatWithId : Nat -> Type
+repeatWithId 0 = Nat
+repeatWithId (S _) = Sing {A = Nat} 0
+
+record Flag where
+  constructor MkFlag
+  id : Nat
+  repeat : case id of
+    0 => Nat
+    (S n) => Sing {A = Nat} 0
+
+record SimpleGlyph where
+  constructor MkSimpleGlyph
+  flag : Flag
+  flag_repeat : Sing {A = Nat} (case flag of
+    MkFlag 0 repeat => repeat
+    MkFlag (S n) repeat => val repeat)

From ed44595f00679c66139be76da92d91771e1b8e84 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 1 Sep 2022 19:28:50 +1000
Subject: [PATCH 25/47] Use the Subset type from the Idris base library

---
 experiments/idris/fathom.ipkg                     |  1 -
 .../idris/src/Fathom/Closed/IndexedInductive.idr  | 14 +++++++-------
 .../src/Fathom/Closed/IndexedInductiveCustom.idr  | 14 +++++++-------
 .../src/Fathom/Closed/InductiveRecursive.idr      | 12 ++++++------
 .../Fathom/Closed/InductiveRecursiveCustom.idr    | 15 +++++++--------
 experiments/idris/src/Fathom/Data/Refine.idr      | 15 ---------------
 6 files changed, 27 insertions(+), 44 deletions(-)
 delete mode 100644 experiments/idris/src/Fathom/Data/Refine.idr

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index 171ffcf34..f721f5e78 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -18,7 +18,6 @@ modules = Fathom
         , Fathom.Data.Bit
         , Fathom.Data.Iso
         , Fathom.Data.Sing
-        , Fathom.Data.Refine
         , Fathom.Data.Word
         , Fathom.Closed.IndexedInductive
         , Fathom.Closed.IndexedInductiveCustom
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 8346549ea..bf48bbe93 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -145,22 +145,22 @@ toFormatOfIso = MkIso
 ||| Convert a format description into an indexed format description with an
 ||| equality proof that the representation is the same as the index.
 public export
-toFormatOfEq : {0 A : Type} -> (f : Format ** f.Rep = A) -> FormatOf A
-toFormatOfEq (f ** prf) = rewrite sym prf in f.format
+toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
+toFormatOfEq (Element f prf) = rewrite sym prf in f.format
 
 
 ||| Convert an indexed format description to a existential format description,
 ||| along with a proof that the representation is the same as the index.
 public export
-toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** f.Rep = A)
-toFormatEq f = (MkFormat A f ** Refl)
+toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
+toFormatEq f = Element (MkFormat A f) Refl
 
 
 public export
-toFormatOfEqIso : Iso (Exists (\a => (f : Format ** f.Rep = a))) (Exists FormatOf)
+toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => f.Rep = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
-  { to = \(Evidence _f) => Evidence _ (toFormatOfEq f)
+  { to = \(Evidence _ f) => Evidence _ (toFormatOfEq f)
   , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
   , toFrom = \(Evidence _ _) => Refl
-  , fromTo = \(Evidence _ ((MkFormat _ _) ** Refl)) => Refl
+  , fromTo = \(Evidence _ (Element (MkFormat _ _) Refl)) => Refl
   }
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index ac3fbc7e5..a56ec062f 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -138,24 +138,24 @@ toFormatOfIso = MkIso
 ||| Convert a format description into an indexed format description with an
 ||| equality proof that the representation is the same as the index.
 public export
-toFormatOfEq : {0 A : Type} -> (f : Format ** f.Rep = A) -> FormatOf A
-toFormatOfEq (f ** prf) = rewrite sym prf in f.format
+toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
+toFormatOfEq (Element f prf) = rewrite sym prf in f.format
 
 
 ||| Convert an indexed format description to a existential format description,
 ||| along with a proof that the representation is the same as the index.
 public export
-toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** f.Rep = A)
-toFormatEq f = (MkFormat A f ** Refl)
+toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
+toFormatEq f = Element (MkFormat A f) Refl
 
 
 public export
-toFormatOfEqIso : Iso (Exists (\a => (f : Format ** f.Rep = a))) (Exists FormatOf)
+toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => f.Rep = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
-  { to = \(Evidence _f) => Evidence _ (toFormatOfEq f)
+  { to = \(Evidence _ f) => Evidence _ (toFormatOfEq f)
   , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
   , toFrom = \(Evidence _ _) => Refl
-  , fromTo = \(Evidence _ ((MkFormat _ _) ** Refl)) => Refl
+  , fromTo = \(Evidence _ (Element (MkFormat _ _) Refl)) => Refl
   }
 
 
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 908751bda..887b44008 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -150,22 +150,22 @@ toFormatOfIso = MkIso
 ||| Convert a format description into an indexed format description with an
 ||| equality proof that the representation is the same as the index.
 public export
-toFormatOfEq : {0 A : Type} -> (f : Format ** Rep f = A) -> FormatOf A
-toFormatOfEq (f ** prf) = rewrite sym prf in MkFormatOf f
+toFormatOfEq : {0 A : Type} -> (Subset Format (\f => Rep f = A)) -> FormatOf A
+toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
 
 
 ||| Convert an indexed format description to a existential format description,
 ||| along with a proof that the representation is the same as the index.
 public export
-toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** Rep f = A)
-toFormatEq (MkFormatOf f) = (f ** Refl)
+toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => Rep f = A))
+toFormatEq (MkFormatOf f) = Element f Refl
 
 
 public export
-toFormatOfEqIso : Iso (Exists (\a => (f : Format ** Rep f = a))) (Exists FormatOf)
+toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => Rep f = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
   { to = \(Evidence _ f) => Evidence _ (toFormatOfEq f)
   , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
   , toFrom = \(Evidence _ (MkFormatOf _)) => Refl
-  , fromTo = \(Evidence _ (f ** Refl)) => Refl
+  , fromTo = \(Evidence _ (Element _ Refl)) => Refl
   }
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 433824acc..5ad3a6284 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -11,7 +11,6 @@ import Data.Vect
 
 import Fathom.Base
 import Fathom.Data.Iso
-import Fathom.Data.Refine
 import Fathom.Data.Sing
 
 
@@ -190,24 +189,24 @@ toFormatOfIso = MkIso
 ||| Convert a format description into an indexed format description with an
 ||| equality proof that the representation is the same as the index.
 public export
-toFormatOfEq : {0 A : Type} -> (f : Format ** Rep f = A) -> FormatOf A
-toFormatOfEq (f ** prf) = rewrite sym prf in MkFormatOf f
+toFormatOfEq : {0 A : Type} -> (Subset Format (\f => Rep f = A)) -> FormatOf A
+toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
 
 
 ||| Convert an indexed format description to a existential format description,
 ||| along with a proof that the representation is the same as the index.
 public export
-toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** Rep f = A)
-toFormatEq (MkFormatOf f) = (f ** Refl)
+toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => Rep f = A))
+toFormatEq (MkFormatOf f) = Element f Refl
 
 
 public export
-toFormatOfEqIso : Iso (Exists (\a => (f : Format ** Rep f = a))) (Exists FormatOf)
+toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => Rep f = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
-  { to = \(Evidence _f) => Evidence _ (toFormatOfEq f)
+  { to = \(Evidence _ f) => Evidence _ (toFormatOfEq f)
   , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
   , toFrom = \(Evidence _ (MkFormatOf _)) => Refl
-  , fromTo = \(Evidence _ (_ ** Refl)) => Refl
+  , fromTo = \(Evidence _ (Element _ Refl)) => Refl
   }
 
 
diff --git a/experiments/idris/src/Fathom/Data/Refine.idr b/experiments/idris/src/Fathom/Data/Refine.idr
deleted file mode 100644
index fca14a0b0..000000000
--- a/experiments/idris/src/Fathom/Data/Refine.idr
+++ /dev/null
@@ -1,15 +0,0 @@
-module Fathom.Data.Refine
-
-
-||| A value that is refined by a proposition.
-|||
-||| The proof of the proposition is erased at runtime.
-|||
-||| This is a bit like `(x : A ** B)`, but with the second element erased.
-public export
-record Refine (0 A : Type) (0 P : A -> Type) where
-  constructor MkRefine
-  ||| The refined value
-  val : A
-  ||| The a proof that @val is refined by @P
-  {auto 0 prf : P val}

From 11d58fc98b7254512df8301eac5cb87a2783f2c2 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 1 Sep 2022 20:13:11 +1000
Subject: [PATCH 26/47] Add constructors for building non-indexed formats

---
 .../src/Fathom/Closed/IndexedInductive.idr    | 41 +++++++++++++++++++
 .../Fathom/Closed/IndexedInductiveCustom.idr  | 41 +++++++++++++++++++
 2 files changed, 82 insertions(+)

diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index bf48bbe93..2dff62ae9 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -164,3 +164,44 @@ toFormatOfEqIso = MkIso
   , toFrom = \(Evidence _ _) => Refl
   , fromTo = \(Evidence _ (Element (MkFormat _ _) Refl)) => Refl
   }
+
+
+-------------------------
+-- FORMAT CONSTRUCTORS --
+-------------------------
+
+-- Helpful constructors for building non-indexed format descriptions.
+-- This also tests if we can actually meaningfully use the `Format` type.
+
+namespace Format
+
+  public export
+  end : Format
+  end = MkFormat () End
+
+
+  public export
+  fail : Format
+  fail = MkFormat Void Fail
+
+
+  public export
+  pure : {0 A : Type} -> (x : A) -> Format
+  pure x = MkFormat (Sing x) (Pure x)
+
+
+  public export
+  skip : (f : Format) -> (def : f.Rep) -> Format
+  skip f def = MkFormat Unit (Skip (toFormatOf f) def)
+
+
+  public export
+  repeat : (len : Nat) -> Format -> Format
+  repeat len f = MkFormat (Vect len f.Rep) (Repeat len (toFormatOf f))
+
+
+  public export
+  bind : (f : Format) -> (Rep f -> Format) -> Format
+  bind f1 f2 =
+      MkFormat (x : f1.Rep ** (f2 x).Rep)
+        (Bind (toFormatOf f1) (\x => toFormatOf (f2 x)))
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index a56ec062f..bc5639da5 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -159,6 +159,47 @@ toFormatOfEqIso = MkIso
   }
 
 
+-------------------------
+-- FORMAT CONSTRUCTORS --
+-------------------------
+
+-- Helpful constructors for building non-indexed format descriptions.
+-- This also tests if we can actually meaningfully use the `Format` type.
+
+namespace Format
+
+  public export
+  end : Format
+  end = MkFormat () End
+
+
+  public export
+  fail : Format
+  fail = MkFormat Void Fail
+
+
+  public export
+  pure : {0 A : Type} -> (x : A) -> Format
+  pure x = MkFormat (Sing x) (Pure x)
+
+
+  public export
+  skip : (f : Format) -> (def : f.Rep) -> Format
+  skip f def = MkFormat Unit (Skip (toFormatOf f) def)
+
+
+  public export
+  repeat : (len : Nat) -> Format -> Format
+  repeat len f = MkFormat (Vect len f.Rep) (Repeat len (toFormatOf f))
+
+
+  public export
+  bind : (f : Format) -> (Rep f -> Format) -> Format
+  bind f1 f2 =
+      MkFormat (x : f1.Rep ** (f2 x).Rep)
+        (Bind (toFormatOf f1) (\x => toFormatOf (f2 x)))
+
+
 --------------------
 -- CUSTOM FORMATS --
 --------------------

From ef540925ef13efb80e31f15f9f839f19d1211f39 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 1 Sep 2022 20:22:36 +1000
Subject: [PATCH 27/47] Begin constructors for wrapper index formats

---
 .../src/Fathom/Closed/InductiveRecursive.idr  | 60 ++++++++++++++--
 .../Closed/InductiveRecursiveCustom.idr       | 72 +++++++++++++++----
 2 files changed, 110 insertions(+), 22 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 887b44008..4c8a47ea1 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -61,15 +61,17 @@ mutual
   Rep (Bind f1 f2) = (x : Rep f1 ** Rep (f2 x))
 
 
--- Support for do notation
+namespace Format
 
-public export
-pure : {0 A : Type} -> A -> Format
-pure = Pure
+  -- Support for do notation
 
-public export
-(>>=) : (f : Format) -> (Rep f -> Format) -> Format
-(>>=) = Bind
+  public export
+  pure : {0 A : Type} -> A -> Format
+  pure = Pure
+
+  public export
+  (>>=) : (f : Format) -> (Rep f -> Format) -> Format
+  (>>=) = Bind
 
 
 ---------------------------
@@ -169,3 +171,47 @@ toFormatOfEqIso = MkIso
   , toFrom = \(Evidence _ (MkFormatOf _)) => Refl
   , fromTo = \(Evidence _ (Element _ Refl)) => Refl
   }
+
+
+---------------------------------
+-- INDEXED FORMAT CONSTRUCTORS --
+---------------------------------
+
+-- Helpful constructors for building index format descriptions.
+-- This also tests if we can actually meaningfully use the `FormatOf` type.
+
+namespace FormatOf
+
+  public export
+  end : FormatOf Unit
+  end = MkFormatOf End
+
+
+  public export
+  fail : FormatOf Void
+  fail = MkFormatOf Fail
+
+
+  public export
+  pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
+  pure x = MkFormatOf (Pure x)
+
+
+  public export
+  skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  skip f def with (toFormatEq f)
+    skip _ def | (Element f prf) = MkFormatOf (Skip f (rewrite prf in def))
+
+
+  public export
+  repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
+  repeat len f with (toFormatEq f)
+    repeat len _ | (Element f prf) =
+      toFormatOfEq (Element (Repeat len f) (cong (Vect len) prf))
+
+
+  public export
+  bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+  bind f1 f2 with (toFormatEq f1)
+    bind _ f2 | (Element f1 prf) =
+      ?todoFormatOf_bind
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 5ad3a6284..5b92d46f3 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -62,6 +62,19 @@ mutual
   Rep (Custom f) = f.Rep
 
 
+namespace Format
+
+  -- Support for do notation
+
+  public export
+  pure : {0 A : Type} -> A -> Format
+  pure = Pure
+
+  public export
+  (>>=) : (f : Format) -> (Rep f -> Format) -> Format
+  (>>=) = Bind
+
+
 ---------------------------
 -- ENCODER/DECODER PAIRS --
 ---------------------------
@@ -103,21 +116,6 @@ encode (Bind f1 f2) (x ** y) =
 encode (Custom f) x = f.encode x
 
 
---------------
--- NOTATION --
---------------
-
--- Support for do notation
-
-public export
-pure : {0 A : Type} -> A -> Format
-pure = Pure
-
-public export
-(>>=) : (f : Format) -> (Rep f -> Format) -> Format
-(>>=) = Bind
-
-
 --------------------
 -- CUSTOM FORMATS --
 --------------------
@@ -210,6 +208,50 @@ toFormatOfEqIso = MkIso
   }
 
 
+---------------------------------
+-- INDEXED FORMAT CONSTRUCTORS --
+---------------------------------
+
+-- Helpful constructors for building index format descriptions.
+-- This also tests if we can actually meaningfully use the `FormatOf` type.
+
+namespace FormatOf
+
+  public export
+  end : FormatOf Unit
+  end = MkFormatOf End
+
+
+  public export
+  fail : FormatOf Void
+  fail = MkFormatOf Fail
+
+
+  public export
+  pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
+  pure x = MkFormatOf (Pure x)
+
+
+  public export
+  skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  skip f def with (toFormatEq f)
+    skip _ def | (Element f prf) = MkFormatOf (Skip f (rewrite prf in def))
+
+
+  public export
+  repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
+  repeat len f with (toFormatEq f)
+    repeat len _ | (Element f prf) =
+      toFormatOfEq (Element (Repeat len f) (cong (Vect len) prf))
+
+
+  public export
+  bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+  bind f1 f2 with (toFormatEq f1)
+    bind _ f2 | (Element f1 prf) =
+      ?todoFormatOf_bind
+
+
 -----------------
 -- EXPERIMENTS --
 -----------------

From 098bbf772e14ee4806d73cc8aa4fd69b47774938 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 2 Sep 2022 09:26:28 +1000
Subject: [PATCH 28/47] Try to construct OpenType things using wrappers

---
 .../src/Fathom/Closed/IndexedInductive.idr    |   5 +
 .../Fathom/Closed/IndexedInductiveCustom.idr  | 142 ++++--
 .../Closed/InductiveRecursiveCustom.idr       | 118 +++--
 experiments/idris/src/Fathom/Open/Record.idr  | 413 ++++++++++++------
 4 files changed, 457 insertions(+), 221 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 2dff62ae9..8d5b248e5 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -205,3 +205,8 @@ namespace Format
   bind f1 f2 =
       MkFormat (x : f1.Rep ** (f2 x).Rep)
         (Bind (toFormatOf f1) (\x => toFormatOf (f2 x)))
+
+
+  public export
+  (>>=) : (f : Format) -> (Rep f -> Format) -> Format
+  (>>=) = bind
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index bc5639da5..151d4a92a 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -200,6 +200,11 @@ namespace Format
         (Bind (toFormatOf f1) (\x => toFormatOf (f2 x)))
 
 
+  public export
+  (>>=) : (f : Format) -> (Rep f -> Format) -> Format
+  (>>=) = bind
+
+
 --------------------
 -- CUSTOM FORMATS --
 --------------------
@@ -238,51 +243,92 @@ u16Be = Custom (MkCustomFormat
 
 -- Reproduction of difficulties in OpenType format
 
-
-Flag : Type
-Flag =
-  (  id : Nat
-  ** repeat :
-    case id of
-      0 => Nat
-      S n => Sing {A = Nat} 0
-  ** Sing ()
-  )
-
-(.repeat) : Flag -> Nat
-(.repeat) (0 ** repeat ** _) = repeat
-(.repeat) (S _ ** repeat ** _) = val repeat
-
-
--- def flag = {
---     flag <- u8,
---     repeat <- match ((u8_and flag 8) != (0 : U8)) {
---       true => u8,
---       false => succeed U8 0,
---     },
--- };
-flag : FormatOf Flag
-flag = do
-  flag <- u8
-  repeat <- case flag of
-    0 => u8
-    S _ => Pure {A = Nat} 0
-  Pure ()
-
-
-SimpleGlyph : Type
-SimpleGlyph =
-  (  flag : Flag
-  ** Sing (flag.repeat + 1)
-  )
-
-
--- def simple_glyph = fun (number_of_contours : U16) => {
---     ...
---     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
---     ...
--- };
-simple_glyph : FormatOf SimpleGlyph
-simple_glyph = do
-  flag <- flag
-  Pure (flag.repeat + 1)
+namespace OpenTypeTest.FormatOf
+
+  Flag : Type
+  Flag =
+    (  id : Nat
+    ** repeat :
+      case id of
+        0 => Nat
+        S n => Sing {A = Nat} 0
+    ** Sing ()
+    )
+
+  (.repeat) : Flag -> Nat
+  (.repeat) (0 ** repeat ** _) = repeat
+  (.repeat) (S _ ** repeat ** _) = val repeat
+
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : FormatOf Flag
+  flag = do
+    flag <- u8
+    repeat <- case flag of
+      0 => u8
+      S _ => Pure {A = Nat} 0
+    Pure ()
+
+
+  SimpleGlyph : Type
+  SimpleGlyph =
+    (  flag : Flag
+    ** Sing (flag.repeat + 1)
+    )
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : FormatOf SimpleGlyph
+  simple_glyph = do
+    flag <- flag
+    Pure (flag.repeat + 1)
+
+
+namespace OpenTypeTest.Format
+
+  -- Reproduction of difficulties in OpenType format
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : Format
+  flag = Format.do
+    id <- toFormat u8
+    repeat <- case id of
+      0 => toFormat u8
+      S n => pure {A = Nat} 0
+    pure ()
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : Format
+  simple_glyph = Format.do
+    flag <- flag
+    let
+      repeat : Nat
+      repeat = ?todo_repeat
+      -- repeat = case the (Format.Rep flag) flag of
+      --   (0 ** repeat ** MkSing ()) => repeat
+      --   (S n ** repeat ** MkSing ()) => repeat
+
+      -- Error: While processing right hand side of simple_glyph. While processing right hand side
+      -- of simple_glyph,repeat. Can't match on 0 as it must have a polymorphic type.
+    pure (repeat + 1)
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 5b92d46f3..988b486a0 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -252,39 +252,97 @@ namespace FormatOf
       ?todoFormatOf_bind
 
 
+  public export
+  (>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+  (>>=) = bind
+
+
 -----------------
 -- EXPERIMENTS --
 -----------------
 
 -- Reproduction of difficulties in OpenType format
 
--- def flag = {
---     flag <- u8,
---     repeat <- match ((u8_and flag 8) != (0 : U8)) {
---       true => u8,
---       false => succeed U8 0,
---     },
--- };
-flag : Format
-flag = do
-  id <- u8
-  repeat <- case id of
-    0 => u8
-    S n => Pure {A = Nat} 0
-  Pure ()
-
-
--- def simple_glyph = fun (number_of_contours : U16) => {
---     ...
---     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
---     ...
--- };
-simple_glyph : Format
-simple_glyph = do
-  flag <- flag
-  let
-    repeat : Nat
-    repeat = case flag of
-      (0 ** repeat ** MkSing ()) => repeat
-      (S n ** repeat ** MkSing ()) => repeat
-  Pure (repeat + 1)
+namespace OpenTypeTest.Format
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : Format
+  flag = do
+    id <- u8
+    repeat <- case id of
+      0 => u8
+      S n => Pure {A = Nat} 0
+    Pure ()
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : Format
+  simple_glyph = do
+    flag <- flag
+    let
+      repeat : Nat
+      repeat = case flag of
+        (0 ** repeat ** MkSing ()) => repeat
+        (S n ** repeat ** MkSing ()) => repeat
+    Pure (repeat + 1)
+
+
+namespace OpenTypeTest.FormatOf
+
+  Flag : Type
+  Flag =
+    (  id : Nat
+    ** repeat :
+      case id of
+        0 => Nat
+        S n => Sing {A = Nat} 0
+    ** Sing ()
+    )
+
+  (.repeat) : Flag -> Nat
+  (.repeat) (0 ** repeat ** _) = repeat
+  (.repeat) (S _ ** repeat ** _) = val repeat
+
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : FormatOf Flag
+  flag = FormatOf.do
+    flag <- toFormatOf u8
+    repeat <- case flag of
+      0 => toFormatOf u8
+      S _ => pure {A = Nat} 0
+    pure ()
+
+
+  SimpleGlyph : Type
+  SimpleGlyph =
+    (  flag : Flag
+    ** Sing (flag.repeat + 1)
+    )
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : FormatOf SimpleGlyph
+  simple_glyph = FormatOf.do
+    flag <- flag
+    pure (flag.repeat + 1)
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index 4b457a0cd..94b5a9c05 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -12,9 +12,11 @@ module Fathom.Open.Record
 
 
 import Data.Colist
+import Data.DPair
 import Data.Vect
 
 import Fathom.Base
+import Fathom.Data.Iso
 import Fathom.Data.Sing
 
 
@@ -31,147 +33,112 @@ record Format where
   encode : Encode Rep ByteStream
 
 
----------------------------------
--- INDEXED FORMAT DESCRIPTIONS --
----------------------------------
-
-
-||| A format description refined with a fixed representation
-public export
-data FormatOf : (0 A : Type) -> Type where
-  MkFormatOf : (f : Format) -> FormatOf f.Rep
-
-
-------------------------------------
--- FORMAT DESCRIPTION CONVERSIONS --
-------------------------------------
-
-
-public export
-toFormatOf : (f : Format) -> FormatOf f.Rep
-toFormatOf f = MkFormatOf f
-
-
-public export
-toFormat : {0 A : Type} -> FormatOf A -> Format
-toFormat (MkFormatOf f) = f
-
-
-public export
-toFormatOfEq : {0 A : Type} -> (f : Format ** f.Rep = A) -> FormatOf A
-toFormatOfEq (f ** prf) = rewrite sym prf in MkFormatOf f
-
-
-public export
-toFormatEq : {0 A : Type} -> FormatOf A -> (f : Format ** f.Rep = A)
-toFormatEq (MkFormatOf f) = (f ** Refl)
-
-
 --------------
 -- FORMATS --
 --------------
 
+namespace Format
 
-public export
-end : Format
-end = MkFormat { Rep, decode, encode } where
-  Rep : Type
-  Rep = Unit
+  public export
+  end : Format
+  end = MkFormat { Rep, decode, encode } where
+    Rep : Type
+    Rep = Unit
 
-  decode : Decode (Rep, ByteStream) ByteStream
-  decode [] = Just ((), [])
-  decode (_::_) = Nothing
+    decode : Decode (Rep, ByteStream) ByteStream
+    decode [] = Just ((), [])
+    decode (_::_) = Nothing
 
-  encode : Encode Rep ByteStream
-  encode () = Just []
+    encode : Encode Rep ByteStream
+    encode () = Just []
 
 
-public export
-fail : Format
-fail = MkFormat { Rep, decode, encode } where
-  Rep : Type
-  Rep = Void
+  public export
+  fail : Format
+  fail = MkFormat { Rep, decode, encode } where
+    Rep : Type
+    Rep = Void
 
-  decode : Decode (Rep, ByteStream) ByteStream
-  decode _ = Nothing
+    decode : Decode (Rep, ByteStream) ByteStream
+    decode _ = Nothing
 
-  encode : Encode Rep ByteStream
-  encode x = void x
+    encode : Encode Rep ByteStream
+    encode x = void x
 
 
-public export
-pure : {0 A : Type} -> A -> Format
-pure x = MkFormat { Rep, decode, encode } where
-  Rep : Type
-  Rep = Sing x
+  public export
+  pure : {0 A : Type} -> A -> Format
+  pure x = MkFormat { Rep, decode, encode } where
+    Rep : Type
+    Rep = Sing x
 
-  decode : Decode (Rep, ByteStream) ByteStream
-  decode buffer = Just (MkSing x, buffer)
+    decode : Decode (Rep, ByteStream) ByteStream
+    decode buffer = Just (MkSing x, buffer)
 
-  encode : Encode Rep ByteStream
-  encode (MkSing _) = Just []
+    encode : Encode Rep ByteStream
+    encode (MkSing _) = Just []
 
 
-public export
-skip : (f : Format) -> (def : f.Rep) -> Format
-skip f def = MkFormat { Rep, decode, encode } where
-  Rep : Type
-  Rep = ()
+  public export
+  skip : (f : Format) -> (def : f.Rep) -> Format
+  skip f def = MkFormat { Rep, decode, encode } where
+    Rep : Type
+    Rep = ()
 
-  decode : Decode (Rep, ByteStream) ByteStream
-  decode buffer = do
-    (x, buffer') <- f.decode buffer
-    Just ((), buffer')
+    decode : Decode (Rep, ByteStream) ByteStream
+    decode buffer = do
+      (x, buffer') <- f.decode buffer
+      Just ((), buffer')
 
-  encode : Encode Rep ByteStream
-  encode () = f.encode def
+    encode : Encode Rep ByteStream
+    encode () = f.encode def
 
 
-public export
-repeat : Nat -> Format -> Format
-repeat len f = MkFormat { Rep, decode, encode } where
-  Rep : Type
-  Rep = Vect len f.Rep
+  public export
+  repeat : Nat -> Format -> Format
+  repeat len f = MkFormat { Rep, decode, encode } where
+    Rep : Type
+    Rep = Vect len f.Rep
 
-  decode : Decode (Rep, ByteStream) ByteStream
-  decode = go len where
-    go : (len : Nat) -> Decode (Vect len f.Rep, ByteStream) ByteStream
-    go 0 buffer = Just ([], buffer)
-    go (S len) buffer = do
-      (x, buffer') <- f.decode buffer
-      (xs, buffer'') <- go len buffer'
-      Just (x :: xs, buffer'')
+    decode : Decode (Rep, ByteStream) ByteStream
+    decode = go len where
+      go : (len : Nat) -> Decode (Vect len f.Rep, ByteStream) ByteStream
+      go 0 buffer = Just ([], buffer)
+      go (S len) buffer = do
+        (x, buffer') <- f.decode buffer
+        (xs, buffer'') <- go len buffer'
+        Just (x :: xs, buffer'')
 
-  encode : Encode Rep ByteStream
-  encode = go len where
-    go : (len : Nat) -> Encode (Vect len f.Rep) ByteStream
-    go 0 [] = Just []
-    go (S len) (x :: xs) =
-      [| f.encode x <+> go len xs |]
+    encode : Encode Rep ByteStream
+    encode = go len where
+      go : (len : Nat) -> Encode (Vect len f.Rep) ByteStream
+      go 0 [] = Just []
+      go (S len) (x :: xs) =
+        [| f.encode x <+> go len xs |]
 
 
-public export
-bind : (f : Format) -> (f.Rep -> Format) -> Format
-bind f1 f2 = MkFormat { Rep, decode, encode } where
-  Rep : Type
-  Rep = (x : f1.Rep ** (f2 x).Rep)
+  public export
+  bind : (f : Format) -> (f.Rep -> Format) -> Format
+  bind f1 f2 = MkFormat { Rep, decode, encode } where
+    Rep : Type
+    Rep = (x : f1.Rep ** (f2 x).Rep)
 
-  decode : Decode (Rep, ByteStream) ByteStream
-  decode buffer = do
-    (x, buffer') <- f1.decode buffer
-    (y, buffer'') <- (f2 x).decode buffer'
-    Just ((x ** y), buffer'')
+    decode : Decode (Rep, ByteStream) ByteStream
+    decode buffer = do
+      (x, buffer') <- f1.decode buffer
+      (y, buffer'') <- (f2 x).decode buffer'
+      Just ((x ** y), buffer'')
 
-  encode : Encode Rep ByteStream
-  encode (x ** y) =
-    [| f1.encode x <+> (f2 x).encode y |]
+    encode : Encode Rep ByteStream
+    encode (x ** y) =
+      [| f1.encode x <+> (f2 x).encode y |]
 
 
--- Support for do notation
+  -- Support for do notation
 
-public export
-(>>=) : (f : Format) -> (Rep f -> Format) -> Format
-(>>=) = bind
+  public export
+  (>>=) : (f : Format) -> (Rep f -> Format) -> Format
+  (>>=) = bind
 
 
 --------------------
@@ -206,41 +173,201 @@ u16Be = MkFormat
   }
 
 
+---------------------------------
+-- INDEXED FORMAT DESCRIPTIONS --
+---------------------------------
+
+
+||| A format description refined with a fixed representation
+public export
+data FormatOf : (A : Type) -> Type where
+  MkFormatOf : (f : Format) -> FormatOf f.Rep
+
+
+------------------------------------
+-- FORMAT DESCRIPTION CONVERSIONS --
+------------------------------------
+
+
+public export
+toFormatOf : (f : Format) -> FormatOf f.Rep
+toFormatOf f = MkFormatOf f
+
+
+public export
+toFormat : {0 A : Type} -> FormatOf A -> Format
+toFormat (MkFormatOf f) = f
+
+
+public export
+toFormatOfIso : Iso Format (Exists FormatOf)
+toFormatOfIso = MkIso
+  { to = \f => Evidence _ (toFormatOf f)
+  , from = \(Evidence _ f) => toFormat f
+  , toFrom = \(Evidence _ (MkFormatOf _)) => Refl
+  , fromTo = \_ => Refl
+  }
+
+
+||| Convert a format description into an indexed format description with an
+||| equality proof that the representation is the same as the index.
+public export
+toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
+toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
+
+
+||| Convert an indexed format description to a existential format description,
+||| along with a proof that the representation is the same as the index.
+public export
+toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
+toFormatEq (MkFormatOf f) = (Element f Refl)
+
+
+public export
+toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => Rep f = a)))) (Exists FormatOf)
+toFormatOfEqIso = MkIso
+  { to = \(Evidence _ f) => Evidence _ (toFormatOfEq f)
+  , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
+  , toFrom = \(Evidence _ (MkFormatOf _)) => Refl
+  , fromTo = \(Evidence _ (Element _ Refl)) => Refl
+  }
+
+
+---------------------------------
+-- INDEXED FORMAT CONSTRUCTORS --
+---------------------------------
+
+-- Helpful constructors for building index format descriptions.
+-- This also tests if we can actually meaningfully use the `FormatOf` type.
+
+namespace FormatOf
+
+  public export
+  end : FormatOf Unit
+  end = MkFormatOf end
+
+
+  public export
+  fail : FormatOf Void
+  fail = MkFormatOf fail
+
+
+  public export
+  pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
+  pure x = MkFormatOf (pure x)
+
+
+  public export
+  skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  skip f def with (toFormatEq f)
+    skip _ def | (Element f prf) = MkFormatOf (skip f (rewrite prf in def))
+
+
+  public export
+  repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
+  repeat len f with (toFormatEq f)
+    repeat len _ | (Element f prf) =
+      toFormatOfEq (Element (repeat len f) (cong (Vect len) prf))
+
+
+  public export
+  bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+  bind f1 f2 with (toFormatEq f1)
+    bind _ f2 | (Element f1 prf) =
+      ?todoFormatOf_bind
+
+
+  public export
+  (>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+  (>>=) = bind
+
+
 -----------------
 -- EXPERIMENTS --
 -----------------
 
-
 -- Reproduction of difficulties in OpenType format
 
-
--- def flag = {
---     flag <- u8,
---     repeat <- match ((u8_and flag 8) != (0 : U8)) {
---       true => u8,
---       false => succeed U8 0,
---     },
--- };
-flag : Format
-flag = do
-  id <- u8
-  repeat <- case id of
-    0 => u8
-    S _ => pure {A = Nat} 0
-  pure ()
-
-
-(.repeat) : Record.flag.Rep -> Nat
-(.repeat) (0 ** repeat ** _) = repeat
-(.repeat) (S _ ** repeat ** _) = val repeat
-
-
--- def simple_glyph = fun (number_of_contours : U16) => {
---     ...
---     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
---     ...
--- };
-simple_glyph : Format
-simple_glyph = do
-  flag <- flag
-  pure (flag.repeat + 1)
+namespace OpenTypeTest.Format
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : Format
+  flag = do
+    id <- u8
+    repeat <- case id of
+      0 => u8
+      S _ => pure {A = Nat} 0
+    pure ()
+
+
+  (.repeat) : Format.flag.Rep -> Nat
+  (.repeat) (0 ** repeat ** _) = repeat
+  (.repeat) (S _ ** repeat ** _) = val repeat
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : Format
+  simple_glyph = do
+    flag <- flag
+    pure (flag.repeat + 1)
+
+
+namespace OpenTypeTest.FormatOf
+
+  Flag : Type
+  Flag =
+    (  id : Nat
+    ** repeat :
+      case id of
+        0 => Nat
+        S n => Sing {A = Nat} 0
+    ** Sing ()
+    )
+
+  (.repeat) : Flag -> Nat
+  (.repeat) (0 ** repeat ** _) = repeat
+  (.repeat) (S _ ** repeat ** _) = val repeat
+
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : FormatOf Flag
+  flag = FormatOf.do
+    flag <- toFormatOf u8
+    repeat <- case flag of
+      0 => toFormatOf u8
+      S _ => pure {A = Nat} 0
+    pure ()
+
+
+  SimpleGlyph : Type
+  SimpleGlyph =
+    (  flag : Flag
+    ** Sing (flag.repeat + 1)
+    )
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : FormatOf SimpleGlyph
+  simple_glyph = FormatOf.do
+    flag <- flag
+    pure (flag.repeat + 1)

From e961d7f77a52509db99fee99bd418027e4c868fc Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 2 Sep 2022 09:45:29 +1000
Subject: [PATCH 29/47] Move experiments into a different module

---
 experiments/idris/fathom.ipkg                 |  7 ++
 .../Fathom/Closed/IndexedInductiveCustom.idr  | 97 ------------------
 .../src/Fathom/Closed/InductiveRecursive.idr  |  5 +
 .../Closed/InductiveRecursiveCustom.idr       | 91 -----------------
 experiments/idris/src/Fathom/Open/Record.idr  | 91 -----------------
 .../Playground/OpenType/IndexedInductive.idr  | 99 +++++++++++++++++++
 .../OpenType/InductiveRecursive.idr           | 92 +++++++++++++++++
 .../idris/src/Playground/OpenType/Record.idr  | 92 +++++++++++++++++
 8 files changed, 295 insertions(+), 279 deletions(-)
 create mode 100644 experiments/idris/src/Playground/OpenType/IndexedInductive.idr
 create mode 100644 experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
 create mode 100644 experiments/idris/src/Playground/OpenType/Record.idr

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index f721f5e78..e7405564b 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -14,17 +14,24 @@ package fathom
 
 -- modules to install
 modules = Fathom
+
         , Fathom.Base
         , Fathom.Data.Bit
         , Fathom.Data.Iso
         , Fathom.Data.Sing
         , Fathom.Data.Word
+
         , Fathom.Closed.IndexedInductive
         , Fathom.Closed.IndexedInductiveCustom
         , Fathom.Closed.InductiveRecursive
         , Fathom.Closed.InductiveRecursiveCustom
         , Fathom.Open.Record
 
+        , Playground
+        , Playground.OpenType.IndexedInductive
+        , Playground.OpenType.InductiveRecursive
+        , Playground.OpenType.Record
+
 -- main file (i.e. file to load at REPL)
 -- main =
 
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index 151d4a92a..bdd9c77c5 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -235,100 +235,3 @@ u16Be = Custom (MkCustomFormat
   , decode = map cast (decodeU16 BE)
   , encode = encodeU16 BE . cast {to = Bits16}
   })
-
-
------------------
--- EXPERIMENTS --
------------------
-
--- Reproduction of difficulties in OpenType format
-
-namespace OpenTypeTest.FormatOf
-
-  Flag : Type
-  Flag =
-    (  id : Nat
-    ** repeat :
-      case id of
-        0 => Nat
-        S n => Sing {A = Nat} 0
-    ** Sing ()
-    )
-
-  (.repeat) : Flag -> Nat
-  (.repeat) (0 ** repeat ** _) = repeat
-  (.repeat) (S _ ** repeat ** _) = val repeat
-
-
-  -- def flag = {
-  --     flag <- u8,
-  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
-  --       true => u8,
-  --       false => succeed U8 0,
-  --     },
-  -- };
-  flag : FormatOf Flag
-  flag = do
-    flag <- u8
-    repeat <- case flag of
-      0 => u8
-      S _ => Pure {A = Nat} 0
-    Pure ()
-
-
-  SimpleGlyph : Type
-  SimpleGlyph =
-    (  flag : Flag
-    ** Sing (flag.repeat + 1)
-    )
-
-
-  -- def simple_glyph = fun (number_of_contours : U16) => {
-  --     ...
-  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
-  --     ...
-  -- };
-  simple_glyph : FormatOf SimpleGlyph
-  simple_glyph = do
-    flag <- flag
-    Pure (flag.repeat + 1)
-
-
-namespace OpenTypeTest.Format
-
-  -- Reproduction of difficulties in OpenType format
-
-  -- def flag = {
-  --     flag <- u8,
-  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
-  --       true => u8,
-  --       false => succeed U8 0,
-  --     },
-  -- };
-  flag : Format
-  flag = Format.do
-    id <- toFormat u8
-    repeat <- case id of
-      0 => toFormat u8
-      S n => pure {A = Nat} 0
-    pure ()
-
-
-  -- def simple_glyph = fun (number_of_contours : U16) => {
-  --     ...
-  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
-  --     ...
-  -- };
-  simple_glyph : Format
-  simple_glyph = Format.do
-    flag <- flag
-    let
-      repeat : Nat
-      repeat = ?todo_repeat
-      -- repeat = case the (Format.Rep flag) flag of
-      --   (0 ** repeat ** MkSing ()) => repeat
-      --   (S n ** repeat ** MkSing ()) => repeat
-
-      -- Error: While processing right hand side of simple_glyph. While processing right hand side
-      -- of simple_glyph,repeat. Can't match on 0 as it must have a polymorphic type.
-    pure (repeat + 1)
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 4c8a47ea1..3e7934c55 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -215,3 +215,8 @@ namespace FormatOf
   bind f1 f2 with (toFormatEq f1)
     bind _ f2 | (Element f1 prf) =
       ?todoFormatOf_bind
+
+
+  public export
+  (>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+  (>>=) = bind
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 988b486a0..57f7366a2 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -255,94 +255,3 @@ namespace FormatOf
   public export
   (>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
   (>>=) = bind
-
-
------------------
--- EXPERIMENTS --
------------------
-
--- Reproduction of difficulties in OpenType format
-
-namespace OpenTypeTest.Format
-
-  -- def flag = {
-  --     flag <- u8,
-  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
-  --       true => u8,
-  --       false => succeed U8 0,
-  --     },
-  -- };
-  flag : Format
-  flag = do
-    id <- u8
-    repeat <- case id of
-      0 => u8
-      S n => Pure {A = Nat} 0
-    Pure ()
-
-
-  -- def simple_glyph = fun (number_of_contours : U16) => {
-  --     ...
-  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
-  --     ...
-  -- };
-  simple_glyph : Format
-  simple_glyph = do
-    flag <- flag
-    let
-      repeat : Nat
-      repeat = case flag of
-        (0 ** repeat ** MkSing ()) => repeat
-        (S n ** repeat ** MkSing ()) => repeat
-    Pure (repeat + 1)
-
-
-namespace OpenTypeTest.FormatOf
-
-  Flag : Type
-  Flag =
-    (  id : Nat
-    ** repeat :
-      case id of
-        0 => Nat
-        S n => Sing {A = Nat} 0
-    ** Sing ()
-    )
-
-  (.repeat) : Flag -> Nat
-  (.repeat) (0 ** repeat ** _) = repeat
-  (.repeat) (S _ ** repeat ** _) = val repeat
-
-
-  -- def flag = {
-  --     flag <- u8,
-  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
-  --       true => u8,
-  --       false => succeed U8 0,
-  --     },
-  -- };
-  flag : FormatOf Flag
-  flag = FormatOf.do
-    flag <- toFormatOf u8
-    repeat <- case flag of
-      0 => toFormatOf u8
-      S _ => pure {A = Nat} 0
-    pure ()
-
-
-  SimpleGlyph : Type
-  SimpleGlyph =
-    (  flag : Flag
-    ** Sing (flag.repeat + 1)
-    )
-
-
-  -- def simple_glyph = fun (number_of_contours : U16) => {
-  --     ...
-  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
-  --     ...
-  -- };
-  simple_glyph : FormatOf SimpleGlyph
-  simple_glyph = FormatOf.do
-    flag <- flag
-    pure (flag.repeat + 1)
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index 94b5a9c05..aacbc8155 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -280,94 +280,3 @@ namespace FormatOf
   public export
   (>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
   (>>=) = bind
-
-
------------------
--- EXPERIMENTS --
------------------
-
--- Reproduction of difficulties in OpenType format
-
-namespace OpenTypeTest.Format
-
-  -- def flag = {
-  --     flag <- u8,
-  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
-  --       true => u8,
-  --       false => succeed U8 0,
-  --     },
-  -- };
-  flag : Format
-  flag = do
-    id <- u8
-    repeat <- case id of
-      0 => u8
-      S _ => pure {A = Nat} 0
-    pure ()
-
-
-  (.repeat) : Format.flag.Rep -> Nat
-  (.repeat) (0 ** repeat ** _) = repeat
-  (.repeat) (S _ ** repeat ** _) = val repeat
-
-
-  -- def simple_glyph = fun (number_of_contours : U16) => {
-  --     ...
-  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
-  --     ...
-  -- };
-  simple_glyph : Format
-  simple_glyph = do
-    flag <- flag
-    pure (flag.repeat + 1)
-
-
-namespace OpenTypeTest.FormatOf
-
-  Flag : Type
-  Flag =
-    (  id : Nat
-    ** repeat :
-      case id of
-        0 => Nat
-        S n => Sing {A = Nat} 0
-    ** Sing ()
-    )
-
-  (.repeat) : Flag -> Nat
-  (.repeat) (0 ** repeat ** _) = repeat
-  (.repeat) (S _ ** repeat ** _) = val repeat
-
-
-  -- def flag = {
-  --     flag <- u8,
-  --     repeat <- match ((u8_and flag 8) != (0 : U8)) {
-  --       true => u8,
-  --       false => succeed U8 0,
-  --     },
-  -- };
-  flag : FormatOf Flag
-  flag = FormatOf.do
-    flag <- toFormatOf u8
-    repeat <- case flag of
-      0 => toFormatOf u8
-      S _ => pure {A = Nat} 0
-    pure ()
-
-
-  SimpleGlyph : Type
-  SimpleGlyph =
-    (  flag : Flag
-    ** Sing (flag.repeat + 1)
-    )
-
-
-  -- def simple_glyph = fun (number_of_contours : U16) => {
-  --     ...
-  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
-  --     ...
-  -- };
-  simple_glyph : FormatOf SimpleGlyph
-  simple_glyph = FormatOf.do
-    flag <- flag
-    pure (flag.repeat + 1)
diff --git a/experiments/idris/src/Playground/OpenType/IndexedInductive.idr b/experiments/idris/src/Playground/OpenType/IndexedInductive.idr
new file mode 100644
index 000000000..23454e5ed
--- /dev/null
+++ b/experiments/idris/src/Playground/OpenType/IndexedInductive.idr
@@ -0,0 +1,99 @@
+||| Reproduction of difficulties in OpenType format
+
+module Playground.OpenType.IndexedInductive
+
+
+import Fathom.Data.Sing
+import Fathom.Closed.IndexedInductiveCustom
+
+
+namespace FormatOf
+
+  Flag : Type
+  Flag =
+    (  id : Nat
+    ** repeat :
+      case id of
+        0 => Nat
+        S n => Sing {A = Nat} 0
+    ** Sing ()
+    )
+
+
+  (.repeat) : Flag -> Nat
+  (.repeat) (0 ** repeat ** _) = repeat
+  (.repeat) (S _ ** repeat ** _) = val repeat
+
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match (flag & 8 != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : FormatOf Flag
+  flag = do
+    flag <- u8
+    repeat <- case flag of
+      0 => u8
+      S _ => Pure {A = Nat} 0
+    Pure ()
+
+
+  SimpleGlyph : Type
+  SimpleGlyph =
+    (  flag : Flag
+    ** Sing (flag.repeat + 1)
+    )
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : FormatOf SimpleGlyph
+  simple_glyph = do
+    flag <- flag
+    Pure (flag.repeat + 1)
+
+
+namespace Format
+
+  -- Reproduction of difficulties in OpenType format
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match (flag & 8 != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : Format
+  flag = Format.do
+    id <- toFormat u8
+    repeat <- case id of
+      0 => toFormat u8
+      S n => pure {A = Nat} 0
+    pure ()
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : Format
+  simple_glyph = Format.do
+    flag <- flag
+    let
+      repeat : Nat
+      repeat = ?todo_repeat
+      -- repeat = case the (Format.Rep flag) flag of
+      --   (0 ** repeat ** MkSing ()) => repeat
+      --   (S n ** repeat ** MkSing ()) => repeat
+
+      -- Error: While processing right hand side of simple_glyph. While processing right hand side
+      -- of simple_glyph,repeat. Can't match on 0 as it must have a polymorphic type.
+    pure (repeat + 1)
diff --git a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
new file mode 100644
index 000000000..89a78bdd1
--- /dev/null
+++ b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
@@ -0,0 +1,92 @@
+||| Reproduction of difficulties in OpenType format
+
+module Playground.OpenType.InductiveRecursive
+
+
+import Fathom.Data.Sing
+import Fathom.Closed.InductiveRecursiveCustom
+
+
+namespace Format
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match (flag & 8 != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : Format
+  flag = do
+    id <- u8
+    repeat <- case id of
+      0 => u8
+      S _ => Pure {A = Nat} 0
+    Pure ()
+
+
+  (.repeat) : Rep Format.flag -> Nat
+  (.repeat) (0 ** repeat ** _) = repeat
+  (.repeat) (S _ ** repeat ** _) = val repeat
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : Format
+  simple_glyph = do
+    flag <- flag
+    Pure (flag.repeat + 1)
+
+
+namespace FormatOf
+
+  Flag : Type
+  Flag =
+    (  id : Nat
+    ** repeat :
+      case id of
+        0 => Nat
+        S n => Sing {A = Nat} 0
+    ** Sing ()
+    )
+
+  (.repeat) : Flag -> Nat
+  (.repeat) (0 ** repeat ** _) = repeat
+  (.repeat) (S _ ** repeat ** _) = val repeat
+
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match (flag & 8 != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : FormatOf Flag
+  flag = FormatOf.do
+    flag <- toFormatOf u8
+    repeat <- case flag of
+      0 => toFormatOf u8
+      S _ => pure {A = Nat} 0
+    pure ()
+
+
+  SimpleGlyph : Type
+  SimpleGlyph =
+    (  flag : Flag
+    ** Sing (flag.repeat + 1)
+    )
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : FormatOf SimpleGlyph
+  simple_glyph = FormatOf.do
+    flag <- flag
+    pure (flag.repeat + 1)
diff --git a/experiments/idris/src/Playground/OpenType/Record.idr b/experiments/idris/src/Playground/OpenType/Record.idr
new file mode 100644
index 000000000..4cfe6c82b
--- /dev/null
+++ b/experiments/idris/src/Playground/OpenType/Record.idr
@@ -0,0 +1,92 @@
+||| Reproduction of difficulties in OpenType format
+
+module Playground.OpenType.Record
+
+
+import Fathom.Data.Sing
+import Fathom.Open.Record
+
+
+namespace Format
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match (flag & 8 != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : Format
+  flag = do
+    id <- u8
+    repeat <- case id of
+      0 => u8
+      S _ => pure {A = Nat} 0
+    pure ()
+
+
+  (.repeat) : Format.flag.Rep -> Nat
+  (.repeat) (0 ** repeat ** _) = repeat
+  (.repeat) (S _ ** repeat ** _) = val repeat
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : Format
+  simple_glyph = do
+    flag <- flag
+    pure (flag.repeat + 1)
+
+
+namespace FormatOf
+
+  Flag : Type
+  Flag =
+    (  id : Nat
+    ** repeat :
+      case id of
+        0 => Nat
+        S n => Sing {A = Nat} 0
+    ** Sing ()
+    )
+
+  (.repeat) : Flag -> Nat
+  (.repeat) (0 ** repeat ** _) = repeat
+  (.repeat) (S _ ** repeat ** _) = val repeat
+
+
+  -- def flag = {
+  --     flag <- u8,
+  --     repeat <- match (flag & 8 != (0 : U8)) {
+  --       true => u8,
+  --       false => succeed U8 0,
+  --     },
+  -- };
+  flag : FormatOf Flag
+  flag = FormatOf.do
+    flag <- toFormatOf u8
+    repeat <- case flag of
+      0 => toFormatOf u8
+      S _ => pure {A = Nat} 0
+    pure ()
+
+
+  SimpleGlyph : Type
+  SimpleGlyph =
+    (  flag : Flag
+    ** Sing (flag.repeat + 1)
+    )
+
+
+  -- def simple_glyph = fun (number_of_contours : U16) => {
+  --     ...
+  --     let flag_repeat = fun (f : Repr flag) => f.repeat + (1 : U8),
+  --     ...
+  -- };
+  simple_glyph : FormatOf SimpleGlyph
+  simple_glyph = FormatOf.do
+    flag <- flag
+    pure (flag.repeat + 1)

From acabfc1e75d52d60049004d7883233eb6eca8a76 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 2 Sep 2022 10:56:46 +1000
Subject: [PATCH 30/47] Make better use of namespaces

---
 .../src/Fathom/Closed/IndexedInductive.idr    | 161 ++++++++--------
 .../Fathom/Closed/IndexedInductiveCustom.idr  | 142 +++++++-------
 .../src/Fathom/Closed/InductiveRecursive.idr  | 126 +++++++------
 .../Closed/InductiveRecursiveCustom.idr       | 174 +++++++++---------
 experiments/idris/src/Fathom/Open/Record.idr  |  92 ++++-----
 experiments/idris/src/Playground.idr          | 134 +++++++++++++-
 6 files changed, 475 insertions(+), 354 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 8d5b248e5..b086b0147 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -29,77 +29,56 @@ data FormatOf : Type -> Type where
   Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
 
 
--- Support for do notation
+namespace FormatOf
 
-public export
-pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
-pure = Pure
+  -- Support for do notation
 
-public export
-(>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
-(>>=) = Bind
-
-
----------------------------
--- ENCODER/DECODER PAIRS --
----------------------------
-
-
-export
-decode : {0 A, S : Type} -> (f : FormatOf A) -> Decode (A, Colist S) (Colist S)
-decode End [] = Just ((), [])
-decode End (_::_) = Nothing
-decode Fail _ = Nothing
-decode (Pure x) buffer =
-  Just (MkSing x, buffer)
-decode (Skip f _) buffer = do
-  (x, buffer') <- decode f buffer
-  Just ((), buffer')
-decode (Repeat 0 f) buffer =
-  Just ([], buffer)
-decode (Repeat (S len) f) buffer = do
-  (x, buffer') <- decode f buffer
-  (xs, buffer'') <- decode (Repeat len f) buffer'
-  Just (x :: xs, buffer'')
-decode (Bind f1 f2) buffer = do
-  (x, buffer') <- decode f1 buffer
-  (y, buffer'') <- decode (f2 x) buffer'
-  Just ((x ** y), buffer'')
-
--- export
--- decode : {0 A, S : Type} -> (f : FormatOf A) -> Decode (A, Colist S) (Colist S)
--- decode End
---   = \buffer => case buffer of
---       [] => Just ((), [])
---       _::_ => Nothing
--- decode Fail
---   = const Nothing
--- decode (Pure x)
---   = pure (MkSing x)
--- decode (Skip f _)
---   = do  _ <- decode f
---         pure ()
--- decode (Repeat 0 f) = pure []
--- decode (Repeat (S len) f)
---   = do  x <- decode f
---         xs <- decode (Repeat len f)
---         pure (x :: xs)
--- decode (Bind f1 f2)
---   = do  x <- decode f1
---         y <- decode (f2 x)
---         pure (x ** y)
-
-
-export
-encode : {0 A, S : Type} -> (f : FormatOf A) -> Encode A (Colist S)
-encode End () = Just []
-encode (Pure x) (MkSing _) = Just []
-encode (Skip f def) () = encode f def
-encode (Repeat Z f) [] = Just []
-encode (Repeat (S len) f) (x :: xs) =
-  [| encode f x <+> encode (Repeat len f) xs |]
-encode (Bind f1 f2) (x ** y) =
-  [| encode f1 x <+> encode (f2 x) y |]
+  public export
+  pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
+  pure = Pure
+
+  public export
+  (>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+  (>>=) = Bind
+
+
+  ---------------------------
+  -- ENCODER/DECODER PAIRS --
+  ---------------------------
+
+
+  export
+  decode : {0 A, S : Type} -> (f : FormatOf A) -> Decode (A, Colist S) (Colist S)
+  decode End [] = Just ((), [])
+  decode End (_::_) = Nothing
+  decode Fail _ = Nothing
+  decode (Pure x) buffer =
+    Just (MkSing x, buffer)
+  decode (Skip f _) buffer = do
+    (x, buffer') <- decode f buffer
+    Just ((), buffer')
+  decode (Repeat 0 f) buffer =
+    Just ([], buffer)
+  decode (Repeat (S len) f) buffer = do
+    (x, buffer') <- decode f buffer
+    (xs, buffer'') <- decode (Repeat len f) buffer'
+    Just (x :: xs, buffer'')
+  decode (Bind f1 f2) buffer = do
+    (x, buffer') <- decode f1 buffer
+    (y, buffer'') <- decode (f2 x) buffer'
+    Just ((x ** y), buffer'')
+
+
+  export
+  encode : {0 A, S : Type} -> (f : FormatOf A) -> Encode A (Colist S)
+  encode End () = Just []
+  encode (Pure x) (MkSing _) = Just []
+  encode (Skip f def) () = encode f def
+  encode (Repeat Z f) [] = Just []
+  encode (Repeat (S len) f) (x :: xs) =
+    [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Bind f1 f2) (x ** y) =
+    [| encode f1 x <+> encode (f2 x) y |]
 
 
 -------------------------
@@ -122,14 +101,32 @@ record Format where
 ------------------------------------
 
 
-public export
-toFormatOf : (f : Format) -> FormatOf f.Rep
-toFormatOf (MkFormat _ f) = f
+namespace Format
 
+  public export
+  toFormatOf : (f : Format) -> FormatOf f.Rep
+  toFormatOf (MkFormat _ f) = f
+
+
+  ||| Convert a format description into an indexed format description with an
+  ||| equality proof that the representation is the same as the index.
+  public export
+  toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
+  toFormatOfEq (Element f prf) = rewrite sym prf in f.format
 
-public export
-toFormat : {0 A : Type} -> FormatOf A -> Format
-toFormat f = MkFormat A f
+
+namespace FormatOf
+
+  public export
+  toFormat : {0 A : Type} -> FormatOf A -> Format
+  toFormat f = MkFormat A f
+
+
+  ||| Convert an indexed format description to a existential format description,
+  ||| along with a proof that the representation is the same as the index.
+  public export
+  toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
+  toFormatEq f = Element (MkFormat A f) Refl
 
 
 public export
@@ -142,20 +139,6 @@ toFormatOfIso = MkIso
   }
 
 
-||| Convert a format description into an indexed format description with an
-||| equality proof that the representation is the same as the index.
-public export
-toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
-toFormatOfEq (Element f prf) = rewrite sym prf in f.format
-
-
-||| Convert an indexed format description to a existential format description,
-||| along with a proof that the representation is the same as the index.
-public export
-toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
-toFormatEq f = Element (MkFormat A f) Refl
-
-
 public export
 toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => f.Rep = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index bdd9c77c5..575b9969b 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -43,56 +43,58 @@ data FormatOf : (A : Type) -> Type where
   Custom :  (f : CustomFormat) -> FormatOf f.Rep
 
 
--- Support for do notation
+namespace FormatOf
 
-public export
-pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
-pure = Pure
+  -- Support for do notation
 
-public export
-(>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
-(>>=) = Bind
-
-
----------------------------
--- ENCODER/DECODER PAIRS --
----------------------------
-
-
-export
-decode : {0 A : Type} -> (f : FormatOf A) -> Decode (A, ByteStream) (ByteStream)
-decode End [] = Just ((), [])
-decode End (_::_) = Nothing
-decode Fail _ = Nothing
-decode (Pure x) buffer =
-  Just (MkSing x, buffer)
-decode (Skip f _) buffer = do
-  (x, buffer') <- decode f buffer
-  Just ((), buffer')
-decode (Repeat 0 f) buffer =
-  Just ([], buffer)
-decode (Repeat (S len) f) buffer = do
-  (x, buffer') <- decode f buffer
-  (xs, buffer'') <- decode (Repeat len f) buffer'
-  Just (x :: xs, buffer'')
-decode (Bind f1 f2) buffer = do
-  (x, buffer') <- decode f1 buffer
-  (y, buffer'') <- decode (f2 x) buffer'
-  Just ((x ** y), buffer'')
-decode (Custom f) buffer = f.decode buffer
-
-
-export
-encode : {0 A : Type} -> (f : FormatOf A) -> Encode A (ByteStream)
-encode End () = Just []
-encode (Pure x) (MkSing _) = Just []
-encode (Skip f def) () = encode f def
-encode (Repeat Z f) [] = Just []
-encode (Repeat (S len) f) (x :: xs) =
-  [| encode f x <+> encode (Repeat len f) xs |]
-encode (Bind f1 f2) (x ** y) =
-  [| encode f1 x <+> encode (f2 x) y |]
-encode (Custom f) x = f.encode x
+  public export
+  pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
+  pure = Pure
+
+  public export
+  (>>=) : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
+  (>>=) = Bind
+
+
+  ---------------------------
+  -- ENCODER/DECODER PAIRS --
+  ---------------------------
+
+
+  export
+  decode : {0 A : Type} -> (f : FormatOf A) -> Decode (A, ByteStream) (ByteStream)
+  decode End [] = Just ((), [])
+  decode End (_::_) = Nothing
+  decode Fail _ = Nothing
+  decode (Pure x) buffer =
+    Just (MkSing x, buffer)
+  decode (Skip f _) buffer = do
+    (x, buffer') <- decode f buffer
+    Just ((), buffer')
+  decode (Repeat 0 f) buffer =
+    Just ([], buffer)
+  decode (Repeat (S len) f) buffer = do
+    (x, buffer') <- decode f buffer
+    (xs, buffer'') <- decode (Repeat len f) buffer'
+    Just (x :: xs, buffer'')
+  decode (Bind f1 f2) buffer = do
+    (x, buffer') <- decode f1 buffer
+    (y, buffer'') <- decode (f2 x) buffer'
+    Just ((x ** y), buffer'')
+  decode (Custom f) buffer = f.decode buffer
+
+
+  export
+  encode : {0 A : Type} -> (f : FormatOf A) -> Encode A (ByteStream)
+  encode End () = Just []
+  encode (Pure x) (MkSing _) = Just []
+  encode (Skip f def) () = encode f def
+  encode (Repeat Z f) [] = Just []
+  encode (Repeat (S len) f) (x :: xs) =
+    [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Bind f1 f2) (x ** y) =
+    [| encode f1 x <+> encode (f2 x) y |]
+  encode (Custom f) x = f.encode x
 
 
 -------------------------
@@ -115,14 +117,32 @@ record Format where
 ------------------------------------
 
 
-public export
-toFormatOf : (f : Format) -> FormatOf f.Rep
-toFormatOf (MkFormat _ f) = f
+namespace Format
 
+  public export
+  toFormatOf : (f : Format) -> FormatOf f.Rep
+  toFormatOf (MkFormat _ f) = f
+
+
+  ||| Convert a format description into an indexed format description with an
+  ||| equality proof that the representation is the same as the index.
+  public export
+  toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
+  toFormatOfEq (Element f prf) = rewrite sym prf in f.format
 
-public export
-toFormat : {0 A : Type} -> FormatOf A -> Format
-toFormat f = MkFormat A f
+
+namespace FormatOf
+
+  public export
+  toFormat : {0 A : Type} -> FormatOf A -> Format
+  toFormat f = MkFormat A f
+
+
+  ||| Convert an indexed format description to a existential format description,
+  ||| along with a proof that the representation is the same as the index.
+  public export
+  toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
+  toFormatEq f = Element (MkFormat A f) Refl
 
 
 public export
@@ -135,20 +155,6 @@ toFormatOfIso = MkIso
   }
 
 
-||| Convert a format description into an indexed format description with an
-||| equality proof that the representation is the same as the index.
-public export
-toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
-toFormatOfEq (Element f prf) = rewrite sym prf in f.format
-
-
-||| Convert an indexed format description to a existential format description,
-||| along with a proof that the representation is the same as the index.
-public export
-toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
-toFormatEq f = Element (MkFormat A f) Refl
-
-
 public export
 toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => f.Rep = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 3e7934c55..ec30b71f3 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -74,43 +74,43 @@ namespace Format
   (>>=) = Bind
 
 
----------------------------
--- ENCODER/DECODER PAIRS --
----------------------------
-
-
-export
-decode : (f : Format) -> Decode (Rep f, Colist a) (Colist a)
-decode End [] = Just ((), [])
-decode End (_::_) = Nothing
-decode Fail _ = Nothing
-decode (Pure x) buffer =
-  Just (MkSing x, buffer)
-decode (Skip f _) buffer = do
-  (x, buffer') <- decode f buffer
-  Just ((), buffer')
-decode (Repeat 0 f) buffer =
-  Just ([], buffer)
-decode (Repeat (S len) f) buffer = do
-  (x, buffer') <- decode f buffer
-  (xs, buffer'') <- decode (Repeat len f) buffer'
-  Just (x :: xs, buffer'')
-decode (Bind f1 f2) buffer = do
-  (x, buffer') <- decode f1 buffer
-  (y, buffer'') <- decode (f2 x) buffer'
-  Just ((x ** y), buffer'')
-
-
-export
-encode : (f : Format) -> Encode (Rep f) (Colist a)
-encode End () = Just []
-encode (Pure x) (MkSing _) = Just []
-encode (Skip f def) () = encode f def
-encode (Repeat Z f) [] = Just []
-encode (Repeat (S len) f) (x :: xs) = do
-  [| encode f x <+> encode (Repeat len f) xs |]
-encode (Bind f1 f2) (x ** y) = do
-  [| encode f1 x <+> encode (f2 x) y |]
+  ---------------------------
+  -- ENCODER/DECODER PAIRS --
+  ---------------------------
+
+
+  export
+  decode : (f : Format) -> Decode (Rep f, Colist a) (Colist a)
+  decode End [] = Just ((), [])
+  decode End (_::_) = Nothing
+  decode Fail _ = Nothing
+  decode (Pure x) buffer =
+    Just (MkSing x, buffer)
+  decode (Skip f _) buffer = do
+    (x, buffer') <- decode f buffer
+    Just ((), buffer')
+  decode (Repeat 0 f) buffer =
+    Just ([], buffer)
+  decode (Repeat (S len) f) buffer = do
+    (x, buffer') <- decode f buffer
+    (xs, buffer'') <- decode (Repeat len f) buffer'
+    Just (x :: xs, buffer'')
+  decode (Bind f1 f2) buffer = do
+    (x, buffer') <- decode f1 buffer
+    (y, buffer'') <- decode (f2 x) buffer'
+    Just ((x ** y), buffer'')
+
+
+  export
+  encode : (f : Format) -> Encode (Rep f) (Colist a)
+  encode End () = Just []
+  encode (Pure x) (MkSing _) = Just []
+  encode (Skip f def) () = encode f def
+  encode (Repeat Z f) [] = Just []
+  encode (Repeat (S len) f) (x :: xs) = do
+    [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Bind f1 f2) (x ** y) = do
+    [| encode f1 x <+> encode (f2 x) y |]
 
 
 ---------------------------------
@@ -129,14 +129,32 @@ data FormatOf : (A : Type) -> Type where
 ------------------------------------
 
 
-public export
-toFormatOf : (f : Format) -> FormatOf (Rep f)
-toFormatOf f = MkFormatOf f
+namespace Format
 
+  public export
+  toFormatOf : (f : Format) -> FormatOf (Rep f)
+  toFormatOf f = MkFormatOf f
+
+
+  ||| Convert a format description into an indexed format description with an
+  ||| equality proof that the representation is the same as the index.
+  public export
+  toFormatOfEq : {0 A : Type} -> (Subset Format (\f => Rep f = A)) -> FormatOf A
+  toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
+
+
+namespace FormatOf
+
+  public export
+  toFormat : {0 A : Type} -> FormatOf A -> Format
+  toFormat (MkFormatOf f) = f
 
-public export
-toFormat : {0 A : Type} -> FormatOf A -> Format
-toFormat (MkFormatOf f) = f
+
+  ||| Convert an indexed format description to a existential format description,
+  ||| along with a proof that the representation is the same as the index.
+  public export
+  toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => Rep f = A))
+  toFormatEq (MkFormatOf f) = Element f Refl
 
 
 public export
@@ -149,20 +167,6 @@ toFormatOfIso = MkIso
   }
 
 
-||| Convert a format description into an indexed format description with an
-||| equality proof that the representation is the same as the index.
-public export
-toFormatOfEq : {0 A : Type} -> (Subset Format (\f => Rep f = A)) -> FormatOf A
-toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
-
-
-||| Convert an indexed format description to a existential format description,
-||| along with a proof that the representation is the same as the index.
-public export
-toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => Rep f = A))
-toFormatEq (MkFormatOf f) = Element f Refl
-
-
 public export
 toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => Rep f = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
@@ -215,6 +219,14 @@ namespace FormatOf
   bind f1 f2 with (toFormatEq f1)
     bind _ f2 | (Element f1 prf) =
       ?todoFormatOf_bind
+    --   toFormatOfEq
+    --     (Bind f1' (\x =>
+    --       case toFormatEq (f2 x) of
+    --         (f2' ** prf) => toFormatEq ?todo)
+    --     ** rewrite prf in ?todoPrfF1)
+    -- -- MkFormatOf (Bind f1 (\x =>
+    -- --   case toFormatEq (f2 x) of
+    -- --     (f2' ** prf) => toFormatOfEq ?todo))
 
 
   public export
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 57f7366a2..8b2b481d5 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -75,77 +75,77 @@ namespace Format
   (>>=) = Bind
 
 
----------------------------
--- ENCODER/DECODER PAIRS --
----------------------------
-
-
-export
-decode : (f : Format) -> Decode (Rep f, ByteStream) ByteStream
-decode End [] = Just ((), [])
-decode End (_::_) = Nothing
-decode Fail _ = Nothing
-decode (Pure x) buffer =
-  Just (MkSing x, buffer)
-decode (Skip f _) buffer = do
-  (x, buffer') <- decode f buffer
-  Just ((), buffer')
-decode (Repeat 0 f) buffer =
-  Just ([], buffer)
-decode (Repeat (S len) f) buffer = do
-  (x, buffer') <- decode f buffer
-  (xs, buffer'') <- decode (Repeat len f) buffer'
-  Just (x :: xs, buffer'')
-decode (Bind f1 f2) buffer = do
-  (x, buffer') <- decode f1 buffer
-  (y, buffer'') <- decode (f2 x) buffer'
-  Just ((x ** y), buffer'')
-decode (Custom f) buffer = f.decode buffer
-
-
-export
-encode : (f : Format) -> Encode (Rep f) ByteStream
-encode End () = Just []
-encode (Pure x) (MkSing _) = Just []
-encode (Skip f def) () = encode f def
-encode (Repeat Z f) [] = Just []
-encode (Repeat (S len) f) (x :: xs) =
-  [| encode f x <+> encode (Repeat len f) xs |]
-encode (Bind f1 f2) (x ** y) =
-  [| encode f1 x <+> encode (f2 x) y |]
-encode (Custom f) x = f.encode x
-
-
---------------------
--- CUSTOM FORMATS --
---------------------
+  ---------------------------
+  -- ENCODER/DECODER PAIRS --
+  ---------------------------
+
+
+  export
+  decode : (f : Format) -> Decode (Rep f, ByteStream) ByteStream
+  decode End [] = Just ((), [])
+  decode End (_::_) = Nothing
+  decode Fail _ = Nothing
+  decode (Pure x) buffer =
+    Just (MkSing x, buffer)
+  decode (Skip f _) buffer = do
+    (x, buffer') <- decode f buffer
+    Just ((), buffer')
+  decode (Repeat 0 f) buffer =
+    Just ([], buffer)
+  decode (Repeat (S len) f) buffer = do
+    (x, buffer') <- decode f buffer
+    (xs, buffer'') <- decode (Repeat len f) buffer'
+    Just (x :: xs, buffer'')
+  decode (Bind f1 f2) buffer = do
+    (x, buffer') <- decode f1 buffer
+    (y, buffer'') <- decode (f2 x) buffer'
+    Just ((x ** y), buffer'')
+  decode (Custom f) buffer = f.decode buffer
+
+
+  export
+  encode : (f : Format) -> Encode (Rep f) ByteStream
+  encode End () = Just []
+  encode (Pure x) (MkSing _) = Just []
+  encode (Skip f def) () = encode f def
+  encode (Repeat Z f) [] = Just []
+  encode (Repeat (S len) f) (x :: xs) =
+    [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Bind f1 f2) (x ** y) =
+    [| encode f1 x <+> encode (f2 x) y |]
+  encode (Custom f) x = f.encode x
+
+
+  --------------------
+  -- CUSTOM FORMATS --
+  --------------------
 
 
-public export
-u8 : Format
-u8 = Custom (MkCustomFormat
-  { Rep = Nat
-  , decode = map cast decodeU8
-  , encode = encodeU8 . cast {to = Bits8}
-  })
+  public export
+  u8 : Format
+  u8 = Custom (MkCustomFormat
+    { Rep = Nat
+    , decode = map cast decodeU8
+    , encode = encodeU8 . cast {to = Bits8}
+    })
 
 
-public export
-u16Le : Format
-u16Le = Custom (MkCustomFormat
-  { Rep = Nat
-  , decode = map cast (decodeU16 LE)
-  , encode = encodeU16 LE . cast {to = Bits16}
-  })
+  public export
+  u16Le : Format
+  u16Le = Custom (MkCustomFormat
+    { Rep = Nat
+    , decode = map cast (decodeU16 LE)
+    , encode = encodeU16 LE . cast {to = Bits16}
+    })
 
 
-public export
-u16Be : Format
-u16Be = Custom (MkCustomFormat
-  { Rep = Nat
-  , decode = map cast (decodeU16 BE)
-  , encode = encodeU16 BE . cast {to = Bits16}
-  })
+  public export
+  u16Be : Format
+  u16Be = Custom (MkCustomFormat
+    { Rep = Nat
+    , decode = map cast (decodeU16 BE)
+    , encode = encodeU16 BE . cast {to = Bits16}
+    })
 
 
 ---------------------------------
@@ -164,14 +164,32 @@ data FormatOf : (Rep : Type) -> Type where
 ------------------------------------
 
 
-public export
-toFormatOf : (f : Format) -> FormatOf (Rep f)
-toFormatOf f = MkFormatOf f
+namespace Format
 
+  public export
+  toFormatOf : (f : Format) -> FormatOf (Rep f)
+  toFormatOf f = MkFormatOf f
+
+
+  ||| Convert a format description into an indexed format description with an
+  ||| equality proof that the representation is the same as the index.
+  public export
+  toFormatOfEq : {0 A : Type} -> (Subset Format (\f => Rep f = A)) -> FormatOf A
+  toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
 
-public export
-toFormat : {0 A : Type} -> FormatOf A -> Format
-toFormat (MkFormatOf f) = f
+
+namespace FormatOf
+
+  public export
+  toFormat : {0 A : Type} -> FormatOf A -> Format
+  toFormat (MkFormatOf f) = f
+
+
+  ||| Convert an indexed format description to a existential format description,
+  ||| along with a proof that the representation is the same as the index.
+  public export
+  toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => Rep f = A))
+  toFormatEq (MkFormatOf f) = Element f Refl
 
 
 public export
@@ -184,20 +202,6 @@ toFormatOfIso = MkIso
   }
 
 
-||| Convert a format description into an indexed format description with an
-||| equality proof that the representation is the same as the index.
-public export
-toFormatOfEq : {0 A : Type} -> (Subset Format (\f => Rep f = A)) -> FormatOf A
-toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
-
-
-||| Convert an indexed format description to a existential format description,
-||| along with a proof that the representation is the same as the index.
-public export
-toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => Rep f = A))
-toFormatEq (MkFormatOf f) = Element f Refl
-
-
 public export
 toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => Rep f = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index aacbc8155..667e4bf2c 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -33,10 +33,6 @@ record Format where
   encode : Encode Rep ByteStream
 
 
---------------
--- FORMATS --
---------------
-
 namespace Format
 
   public export
@@ -146,31 +142,33 @@ namespace Format
 --------------------
 
 
-public export
-u8 : Format
-u8 = MkFormat
-  { Rep = Nat
-  , decode = map cast decodeU8
-  , encode = encodeU8 . cast {to = Bits8}
-  }
+namespace Format
 
+  public export
+  u8 : Format
+  u8 = MkFormat
+    { Rep = Nat
+    , decode = map cast decodeU8
+    , encode = encodeU8 . cast {to = Bits8}
+    }
 
-public export
-u16Le : Format
-u16Le = MkFormat
-  { Rep = Nat
-  , decode = map cast (decodeU16 LE)
-  , encode = encodeU16 LE . cast {to = Bits16}
-  }
+
+  public export
+  u16Le : Format
+  u16Le = MkFormat
+    { Rep = Nat
+    , decode = map cast (decodeU16 LE)
+    , encode = encodeU16 LE . cast {to = Bits16}
+    }
 
 
-public export
-u16Be : Format
-u16Be = MkFormat
-  { Rep = Nat
-  , decode = map cast (decodeU16 BE)
-  , encode = encodeU16 BE . cast {to = Bits16}
-  }
+  public export
+  u16Be : Format
+  u16Be = MkFormat
+    { Rep = Nat
+    , decode = map cast (decodeU16 BE)
+    , encode = encodeU16 BE . cast {to = Bits16}
+    }
 
 
 ---------------------------------
@@ -189,14 +187,32 @@ data FormatOf : (A : Type) -> Type where
 ------------------------------------
 
 
-public export
-toFormatOf : (f : Format) -> FormatOf f.Rep
-toFormatOf f = MkFormatOf f
+namespace Format
 
+  public export
+  toFormatOf : (f : Format) -> FormatOf f.Rep
+  toFormatOf f = MkFormatOf f
 
-public export
-toFormat : {0 A : Type} -> FormatOf A -> Format
-toFormat (MkFormatOf f) = f
+
+  ||| Convert a format description into an indexed format description with an
+  ||| equality proof that the representation is the same as the index.
+  public export
+  toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
+  toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
+
+
+namespace FormatOf
+
+  public export
+  toFormat : {0 A : Type} -> FormatOf A -> Format
+  toFormat (MkFormatOf f) = f
+
+
+  ||| Convert an indexed format description to a existential format description,
+  ||| along with a proof that the representation is the same as the index.
+  public export
+  toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
+  toFormatEq (MkFormatOf f) = Element f Refl
 
 
 public export
@@ -209,20 +225,6 @@ toFormatOfIso = MkIso
   }
 
 
-||| Convert a format description into an indexed format description with an
-||| equality proof that the representation is the same as the index.
-public export
-toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
-toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
-
-
-||| Convert an indexed format description to a existential format description,
-||| along with a proof that the representation is the same as the index.
-public export
-toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
-toFormatEq (MkFormatOf f) = (Element f Refl)
-
-
 public export
 toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => Rep f = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index d339d3038..ed9127145 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -18,9 +18,9 @@ import Fathom.Open.Record as Record
 public export
 format : IndRec.Format -> Record.Format
 format f = Record.MkFormat
-  { Rep = IndRec.Rep f
-  , decode = IndRec.decode f
-  , encode = IndRec.encode f
+  { Rep = Rep f
+  , decode = decode f
+  , encode = encode f
   }
 
 
@@ -29,8 +29,8 @@ public export
 formatOf : {Rep : Type} -> Indexed.FormatOf Rep -> Record.Format
 formatOf f = Record.MkFormat
   { Rep = Rep
-  , decode = Indexed.decode f
-  , encode = Indexed.encode f
+  , decode = decode f
+  , encode = encode f
   }
 
 
@@ -100,22 +100,136 @@ mutual
     _ | MkFormatOf f' = MkFormatOf (Repeat len f')
   indexedToIndRecFormatOf (Bind f1 f2) with (indexedToIndRecFormatOf f1)
     _ | MkFormatOf f1' =
+  --     -- let
+  --     --   bindF1F2 = Bind f1' (\x =>
+  --     --     let
+  --     --       (f2' ** _) = toFormat (indexedToIndRecFormatOf (f2 x))
+  --     --     in
+  --     --       ?indexedToIndRecFormatOfBind_f2)
+  --     -- in
+  --     -- ?indexedToIndRecFormatOfBind
+  --     MkFormatOf (Bind f1' (\x =>
+  --         let
+  --           (f2' ** prf) = toFormat (indexedToIndRecFormatOf (f2 x))
+  --         in
+  --           ?indexedToIndRecFormatOfBind_f2))
+  -- indexedToIndRecFormatOf (Bind f1 f2) with (indexedToIndRecFormat (MkFormat _ f1))
+  --   _ | (f1' ** prf) =
       ?indexedToIndRecFormatOfBind
 
 
+-- ||| Convert an indexed format description to an inductive-recursive format
+-- indexedToIndRec : {0 A : Type} -> (f : Indexed.FormatOf A) -> IndRec.FormatOf A
+-- indexedToIndRec End = MkFormatOf IndRec.End
+-- indexedToIndRec Fail = MkFormatOf IndRec.Fail
+-- indexedToIndRec (Pure x) = MkFormatOf (IndRec.Pure x)
+-- indexedToIndRec (Skip f def) with (indexedToIndRec f)
+--   indexedToIndRec (Skip _ def) | MkFormatOf f = MkFormatOf (IndRec.Skip f def)
+-- indexedToIndRec (Repeat len f) with (indexedToIndRec f)
+--   indexedToIndRec (Repeat len _) | MkFormatOf f = MkFormatOf (IndRec.Repeat len f)
+-- indexedToIndRec (Bind f1 f2) with (indexedToIndRec f1)
+--   indexedToIndRec (Bind _ f2) | MkFormatOf f1 =
+--     ?todo_indexedToIndRec
+
+-- indexedToIndRec (Bind f1 f2) with (indexedToIndRec f1)
+  -- _ | (MkFormatOf End) = MkFormatOf (Bind End ?todo_indexedToIndRec_2)
+  -- _ | (MkFormatOf Fail) = MkFormatOf (Bind Fail absurd)
+  -- _ | (MkFormatOf (Pure f)) = MkFormatOf (Bind ?todo_indexedToIndRec_4)
+  -- _ | (MkFormatOf (Skip f def)) = MkFormatOf (Bind ?todo_indexedToIndRec_5)
+  -- _ | (MkFormatOf (Repeat k x)) = MkFormatOf (Bind ?todo_indexedToIndRec_6)
+  -- _ | (MkFormatOf (Bind f g)) = MkFormatOf (Bind ?todo_indexedToIndRec_7)
+
+-- indexedToIndRec (Bind f1 f2) with (sameRep (indexedToIndRec f1))
+--   indexedToIndRec (Bind _ f2) | (f1' ** prf) =
+--     rewrite sym prf in MkFormatOf (Bind f1' (\x => ?todo_indexedToIndRec))
+--     where
+--       indexedToIndRecF2 : {0 A : Type} -> {0 B : A -> Type} -> ((x : A) -> Indexed.FormatOf (B x)) -> ((x : A) -> IndRec.FormatOf (B x))
+--       indexedToIndRecF2 x = ?todofF2
+
+-- indexedToIndRec (Bind f1 f2) with (indexedToIndRec f1)
+--   indexedToIndRec (Bind _ f2) | MkFormatOf f1 =
+--     let
+--       bindF1 = Bind f1
+--       bodyF2 : x : Rep f1 -> FormatOf ()
+--       bodyF2 = x : Rep f1 =>
+--         case sameRep (indexedToIndRec (f2 x)) of
+--           (f2' ** prf) => f2')
+--     in
+--     ?todo_indexedToIndRec
+--     where
+--       indexedToIndRecF2 : {0 A : Type} -> {0 B : A -> Type} -> ((x : A) -> Indexed.FormatOf (B x)) -> ((x : A) -> IndRec.FormatOf (B x))
+--       indexedToIndRecF2 x = ?todofF2
+
+-- indexedToIndRec (Bind f1 f2) with (sameRep (indexedToIndRec f1))
+--   _ | (End ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_2
+--   _ | (Fail ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_3
+--   _ | ((Pure f) ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_4
+--   _ | ((Skip f def) ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_5
+--   _ | ((Repeat k x) ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_6
+--   _ | ((Bind f g) ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_7
+
+-- indexedToIndRec (Bind f1 f2) with (sameRep (indexedToIndRec f1))
+--   indexedToIndRec (Bind _ f2) | (f1' ** prf) =
+--     let bindF1 = Bind f1' in
+    -- MkFormatOf (Bind f1' (\x =>
+    --   let
+    --     f2' = f2 x
+    --     -- f2'' = sameRep f2'
+    --   in
+    --     ?help))
+  -- let f1' = indexedToIndRec f1
+  --     (f1'', fromRep) = sameRep' f1'
+  -- in
+
+-- indexedToIndRec (Bind f1 f2) = indexedToIndRecBind f1 f2
+-- indexedToIndRec (Bind f1 f2) with (sameRep (indexedToIndRec f1))
+--   indexedToIndRec (Bind _ f2) | (f1 ** prf) =
+--     let hmm = Bind f1
+--     in
+--     --    f1 : Format
+--     --  0 A : Type
+--     --    f2 : (x : Rep f1) -> FormatOf (B x)
+--     -- ------------------------------
+--     -- todo_indexedToIndRec : FormatOf (DPair (Rep f1) (\x => B x))
+    -- ?todo_indexedToIndRec
+    -- MkFormatOf (Bind f1 (\x => ?help))
+--     --   let
+--     --   --   x' : A
+--     --   --   x' = x
+--     --     f2' = f2 x
+--     --     MkFormatOf f2'' = indexedToIndRec f2'
+--     --   in
+--     --   f2''))
+
+-- indexedToIndRec' : {0 A : Type} -> (f : Indexed.FormatOf A) -> IndRec.Format
+-- indexedToIndRec' End = IndRec.End
+-- indexedToIndRec' Fail = IndRec.Fail
+-- indexedToIndRec' (Pure x) = IndRec.Pure x
+-- indexedToIndRec' (Skip f def) with (MkFormatOf (indexedToIndRec' f))
+--   _ | f' = IndRec.Skip (indexedToIndRec' f) ?todo1
+-- indexedToIndRec' (Repeat len f) = IndRec.Repeat len (indexedToIndRec' f)
+-- indexedToIndRec' (Bind f1 f2) = IndRec.Bind (indexedToIndRec' f1) ?todo2
+
+
+-- indexedToIndRec'' : (f : Indexed.Format) -> IndRec.Format
+-- indexedToIndRec'' (MkFormat () End) = IndRec.End
+-- indexedToIndRec'' (MkFormat Void Fail) = IndRec.Fail
+-- indexedToIndRec'' (MkFormat (Sing x) (Pure x)) = IndRec.Pure x
+-- indexedToIndRec'' (MkFormat () (Skip f def)) with (indexedToIndRec'' (MkFormat _ f))
+--   _ | f'' = IndRec.Skip f'' ?tododef
+-- indexedToIndRec'' (MkFormat rep (Repeat len f)) = IndRec.Repeat len (indexedToIndRec'' f)
+-- indexedToIndRec'' (MkFormat rep (Bind f1 f2)) = IndRec.Bind (indexedToIndRec'' f1) ?todo2
+
+
 -- Reproduction of difficulties in OpenType format, drawing parallels to
 -- Tarski-style universes.
 
-repeatWithId : Nat -> Type
-repeatWithId 0 = Nat
-repeatWithId (S _) = Sing {A = Nat} 0
-
 record Flag where
   constructor MkFlag
   id : Nat
   repeat : case id of
     0 => Nat
-    (S n) => Sing {A = Nat} 0
+    S n => Sing {A = Nat} 0
 
 record SimpleGlyph where
   constructor MkSimpleGlyph

From 152fb8ab9c453680075aeee8d9a918afba697cf3 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 2 Sep 2022 11:27:20 +1000
Subject: [PATCH 31/47] Forwar encode/decode functions via wrapper formats

---
 .../idris/src/Fathom/Closed/IndexedInductive.idr   | 10 ++++++++++
 .../src/Fathom/Closed/IndexedInductiveCustom.idr   | 14 ++++++++++++--
 .../idris/src/Fathom/Closed/InductiveRecursive.idr | 10 ++++++++++
 .../src/Fathom/Closed/InductiveRecursiveCustom.idr | 10 ++++++++++
 experiments/idris/src/Fathom/Open/Record.idr       | 10 ++++++++++
 5 files changed, 52 insertions(+), 2 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index b086b0147..2f45e589a 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -96,6 +96,16 @@ record Format where
   format : FormatOf Rep
 
 
+namespace Format
+
+  decode : (f : Format) -> Decode (Rep f, Colist a) (Colist a)
+  decode f = FormatOf.decode f.format
+
+
+  encode : (f : Format) -> Encode (Rep f) (Colist a)
+  encode f = FormatOf.encode f.format
+
+
 ------------------------------------
 -- FORMAT DESCRIPTION CONVERSIONS --
 ------------------------------------
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index 575b9969b..eb6742600 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -62,7 +62,7 @@ namespace FormatOf
 
 
   export
-  decode : {0 A : Type} -> (f : FormatOf A) -> Decode (A, ByteStream) (ByteStream)
+  decode : {0 A : Type} -> (f : FormatOf A) -> Decode (A, ByteStream) ByteStream
   decode End [] = Just ((), [])
   decode End (_::_) = Nothing
   decode Fail _ = Nothing
@@ -85,7 +85,7 @@ namespace FormatOf
 
 
   export
-  encode : {0 A : Type} -> (f : FormatOf A) -> Encode A (ByteStream)
+  encode : {0 A : Type} -> (f : FormatOf A) -> Encode A ByteStream
   encode End () = Just []
   encode (Pure x) (MkSing _) = Just []
   encode (Skip f def) () = encode f def
@@ -112,6 +112,16 @@ record Format where
   format : FormatOf Rep
 
 
+namespace Format
+
+  decode : (f : Format) -> Decode (Rep f, ByteStream) ByteStream
+  decode f = FormatOf.decode f.format
+
+
+  encode : (f : Format) -> Encode (Rep f) ByteStream
+  encode f = FormatOf.encode f.format
+
+
 ------------------------------------
 -- FORMAT DESCRIPTION CONVERSIONS --
 ------------------------------------
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index ec30b71f3..32cd8c444 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -124,6 +124,16 @@ data FormatOf : (A : Type) -> Type where
   MkFormatOf : (f : Format) -> FormatOf (Rep f)
 
 
+namespace FormatOf
+
+  decode : {0 A : Type} -> (f : FormatOf A) -> Decode (A, ByteStream) ByteStream
+  decode  (MkFormatOf f) = Format.decode f
+
+
+  encode : {0 A : Type} -> (f : FormatOf A) -> Encode A ByteStream
+  encode  (MkFormatOf f) = Format.encode f
+
+
 ------------------------------------
 -- FORMAT DESCRIPTION CONVERSIONS --
 ------------------------------------
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 8b2b481d5..735cc5789 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -159,6 +159,16 @@ data FormatOf : (Rep : Type) -> Type where
   MkFormatOf : (f : Format) -> FormatOf (Rep f)
 
 
+namespace FormatOf
+
+  decode : {0 A : Type} -> (f : FormatOf A) -> Decode (A, ByteStream) ByteStream
+  decode  (MkFormatOf f) = Format.decode f
+
+
+  encode : {0 A : Type} -> (f : FormatOf A) -> Encode A ByteStream
+  encode  (MkFormatOf f) = Format.encode f
+
+
 ------------------------------------
 -- FORMAT DESCRIPTION CONVERSIONS --
 ------------------------------------
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index 667e4bf2c..b221cbb98 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -182,6 +182,16 @@ data FormatOf : (A : Type) -> Type where
   MkFormatOf : (f : Format) -> FormatOf f.Rep
 
 
+namespace FormatOf
+
+  decode : {0 A : Type} -> (f : FormatOf A) -> Decode (A, ByteStream) ByteStream
+  decode  (MkFormatOf f) = Format.decode f
+
+
+  encode : {0 A : Type} -> (f : FormatOf A) -> Encode A ByteStream
+  encode  (MkFormatOf f) = Format.encode f
+
+
 ------------------------------------
 -- FORMAT DESCRIPTION CONVERSIONS --
 ------------------------------------

From aaa95c948b654924424aeab09f016ca81c088815 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 2 Sep 2022 14:04:33 +1000
Subject: [PATCH 32/47] Clean up some state passing with do notation

---
 experiments/idris/src/Fathom/Base.idr         | 70 ++++++++++++-------
 .../src/Fathom/Closed/IndexedInductive.idr    | 33 ++++-----
 .../Fathom/Closed/IndexedInductiveCustom.idr  | 37 +++++-----
 .../src/Fathom/Closed/InductiveRecursive.idr  | 35 +++++-----
 .../Closed/InductiveRecursiveCustom.idr       | 37 +++++-----
 experiments/idris/src/Fathom/Open/Record.idr  | 44 ++++++------
 6 files changed, 130 insertions(+), 126 deletions(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index 006a9878e..48353e0b0 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -69,21 +69,37 @@ parameters (Source, Target : Type)
 
 namespace DecodePart
 
+  -- TODO: Should probably implement functor, applicative, or monad here. or use
+  -- the reader, writer or state monad transformers
+
   public export
   pure : {0 S, T : Type} -> S -> DecodePart S T
   pure source target = Just (source, target)
 
+
   public export
   map : {0 S1, S2, T : Type} -> (S1 -> S2) -> DecodePart S1 T -> DecodePart S2 T
   map f decode target =
     Prelude.map (\(source, target') => (f source, target)) (decode target)
 
 
+  public export
+  bind : {0 S1, S2, T : Type} -> DecodePart S1 T -> (S1 -> DecodePart S2 T) -> DecodePart S2 T
+  bind decode1 decode2 target = do
+    (source1, target') <- decode1 target
+    decode2 source1 target'
+
+
+  public export
+  (>>=) : {0 S1, S2, T : Type} -> DecodePart S1 T -> (S1 -> DecodePart S2 T) -> DecodePart S2 T
+  (>>=) = bind
+
+
 parameters {0 Source, Target : Type}
 
   public export
   toDecodeFull : (Monoid Target, Eq Target) => DecodePart Source Target -> Decode Source Target
-  toDecodeFull decode target = do
+  toDecodeFull decode target = Prelude.do
     (source, target') <- decode target
     if target == neutral then Just source else Nothing
 
@@ -160,14 +176,8 @@ data ByteOrder : Type where
 
 namespace ByteStream
 
-  splitLen : (n : Nat) -> Colist a -> Maybe (Vect n a, Colist a)
-  splitLen 0 _ = Nothing
-  splitLen (S k) [] = Nothing
-  splitLen (S k) (x :: rest) = Prelude.map (\(xs, rest') => (x :: xs, rest')) (splitLen k rest)
-
-
   export
-  decodeU8 : Decode (Bits8, ByteStream) ByteStream
+  decodeU8 : DecodePart Bits8 ByteStream
   decodeU8 [] = Nothing
   decodeU8 (x :: bytes) =  Just (x, bytes)
 
@@ -178,15 +188,15 @@ namespace ByteStream
 
 
   export
-  decodeU16 : ByteOrder -> Decode (Bits16, ByteStream) ByteStream
-  decodeU16 LE bytes = do
-    (bs, bytes') <- splitLen 2 bytes
-    let [b0, b1] = map (cast {to = Bits16}) bs
-    Just (b0 .|. b1 `shiftL` fromNat 8, bytes')
-  decodeU16 BE bytes = do
-    (bs, bytes') <- splitLen 2 bytes
-    let [b0, b1] = map (cast {to = Bits16}) bs
-    Just (b0 `shiftL` fromNat 8 .|. b1, bytes')
+  decodeU16 : ByteOrder -> DecodePart Bits16 ByteStream
+  decodeU16 LE = DecodePart.do
+    b0 <- map (cast {to = Bits16}) decodeU8
+    b1 <- map (cast {to = Bits16}) decodeU8
+    pure (b0 .|. b1 `shiftL` fromNat 8)
+  decodeU16 BE = DecodePart.do
+    b0 <- map (cast {to = Bits16}) decodeU8
+    b1 <- map (cast {to = Bits16}) decodeU8
+    pure (b0 `shiftL` fromNat 8 .|. b1)
 
 
   export
@@ -196,18 +206,26 @@ namespace ByteStream
 
 
   export
-  decodeU32 : ByteOrder -> Decode (Bits32, ByteStream) ByteStream
-  decodeU32 LE bytes = do
-    (bs, bytes') <- splitLen 4 bytes
-    let [b0, b1, b2, b3] = map (cast {to = Bits32}) bs
-    Just (b0 .|. b1 `shiftL` fromNat 8 .|. b2 `shiftL` fromNat 16 .|. b2 `shiftL` fromNat 24, bytes')
-  decodeU32 BE bytes = do
-    (bs, bytes') <- splitLen 4 bytes
-    let [b0, b1, b2, b3] = map (cast {to = Bits32}) bs
-    Just (b0 `shiftL` fromNat 24 .|. b1 `shiftL` fromNat 16 .|. b2 `shiftL` fromNat 8 .|. b3, bytes')
+  decodeU32 : ByteOrder -> DecodePart Bits32 ByteStream
+  decodeU32 LE = DecodePart.do
+    b0 <- map (cast {to = Bits32}) decodeU8
+    b1 <- map (cast {to = Bits32}) decodeU8
+    b2 <- map (cast {to = Bits32}) decodeU8
+    b3 <- map (cast {to = Bits32}) decodeU8
+    pure (b0 .|. b1 `shiftL` fromNat 8 .|. b2 `shiftL` fromNat 16 .|. b2 `shiftL` fromNat 24)
+  decodeU32 BE = DecodePart.do
+    b0 <- map (cast {to = Bits32}) decodeU8
+    b1 <- map (cast {to = Bits32}) decodeU8
+    b2 <- map (cast {to = Bits32}) decodeU8
+    b3 <- map (cast {to = Bits32}) decodeU8
+    pure (b0 `shiftL` fromNat 24 .|. b1 `shiftL` fromNat 16 .|. b2 `shiftL` fromNat 8 .|. b3)
 
 
   export
   encodeU32 : ByteOrder -> Encode Bits32 ByteStream
   encodeU32 LE x = Just [cast x, cast (x `shiftR` fromNat 8), cast (x `shiftR` fromNat 16), cast (x `shiftR` fromNat 24)]
   encodeU32 BE x = Just [cast (x `shiftR` fromNat 24), cast (x `shiftR` fromNat 16), cast (x `shiftR` fromNat 8), cast x]
+
+
+  -- decodeU : Bits a => ByteOrder -> DecodePart a ByteStream
+  -- encodeU : Bits a => ByteOrder -> Encode a ByteStream
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 2f45e589a..4e8100a71 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -49,24 +49,21 @@ namespace FormatOf
 
   export
   decode : {0 A, S : Type} -> (f : FormatOf A) -> Decode (A, Colist S) (Colist S)
-  decode End [] = Just ((), [])
-  decode End (_::_) = Nothing
-  decode Fail _ = Nothing
-  decode (Pure x) buffer =
-    Just (MkSing x, buffer)
-  decode (Skip f _) buffer = do
-    (x, buffer') <- decode f buffer
-    Just ((), buffer')
-  decode (Repeat 0 f) buffer =
-    Just ([], buffer)
-  decode (Repeat (S len) f) buffer = do
-    (x, buffer') <- decode f buffer
-    (xs, buffer'') <- decode (Repeat len f) buffer'
-    Just (x :: xs, buffer'')
-  decode (Bind f1 f2) buffer = do
-    (x, buffer') <- decode f1 buffer
-    (y, buffer'') <- decode (f2 x) buffer'
-    Just ((x ** y), buffer'')
+  decode End =
+    \case [] => Just ((), [])
+          (_::_) => Nothing
+  decode Fail = const Nothing
+  decode (Pure x) = pure (MkSing x)
+  decode (Skip f _) = map (const ()) (decode f)
+  decode (Repeat 0 f) = pure []
+  decode (Repeat (S len) f) = do
+    x <- decode f
+    xs <- decode (Repeat len f)
+    pure (x :: xs)
+  decode (Bind f1 f2) = do
+    x <- decode f1
+    y <- decode (f2 x)
+    pure (x ** y)
 
 
   export
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index eb6742600..45a45cb62 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -62,26 +62,23 @@ namespace FormatOf
 
 
   export
-  decode : {0 A : Type} -> (f : FormatOf A) -> Decode (A, ByteStream) ByteStream
-  decode End [] = Just ((), [])
-  decode End (_::_) = Nothing
-  decode Fail _ = Nothing
-  decode (Pure x) buffer =
-    Just (MkSing x, buffer)
-  decode (Skip f _) buffer = do
-    (x, buffer') <- decode f buffer
-    Just ((), buffer')
-  decode (Repeat 0 f) buffer =
-    Just ([], buffer)
-  decode (Repeat (S len) f) buffer = do
-    (x, buffer') <- decode f buffer
-    (xs, buffer'') <- decode (Repeat len f) buffer'
-    Just (x :: xs, buffer'')
-  decode (Bind f1 f2) buffer = do
-    (x, buffer') <- decode f1 buffer
-    (y, buffer'') <- decode (f2 x) buffer'
-    Just ((x ** y), buffer'')
-  decode (Custom f) buffer = f.decode buffer
+  decode : {0 A : Type} -> (f : FormatOf A) -> DecodePart A ByteStream
+  decode End =
+    \case [] => Just ((), [])
+          (_::_) => Nothing
+  decode Fail = const Nothing
+  decode (Pure x) = pure (MkSing x)
+  decode (Skip f _) = map (const ()) (decode f)
+  decode (Repeat 0 f) = pure []
+  decode (Repeat (S len) f) = do
+    x <- decode f
+    xs <- decode (Repeat len f)
+    pure (x :: xs)
+  decode (Bind f1 f2) = do
+    x <- decode f1
+    y <- decode (f2 x)
+    pure (x ** y)
+  decode (Custom f) = f.decode
 
 
   export
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 32cd8c444..2faaf2540 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -80,25 +80,22 @@ namespace Format
 
 
   export
-  decode : (f : Format) -> Decode (Rep f, Colist a) (Colist a)
-  decode End [] = Just ((), [])
-  decode End (_::_) = Nothing
-  decode Fail _ = Nothing
-  decode (Pure x) buffer =
-    Just (MkSing x, buffer)
-  decode (Skip f _) buffer = do
-    (x, buffer') <- decode f buffer
-    Just ((), buffer')
-  decode (Repeat 0 f) buffer =
-    Just ([], buffer)
-  decode (Repeat (S len) f) buffer = do
-    (x, buffer') <- decode f buffer
-    (xs, buffer'') <- decode (Repeat len f) buffer'
-    Just (x :: xs, buffer'')
-  decode (Bind f1 f2) buffer = do
-    (x, buffer') <- decode f1 buffer
-    (y, buffer'') <- decode (f2 x) buffer'
-    Just ((x ** y), buffer'')
+  decode : (f : Format) -> DecodePart (Rep f) (Colist a)
+  decode End =
+    \case [] => Just ((), [])
+          (_::_) => Nothing
+  decode Fail = const Nothing
+  decode (Pure x) = pure (MkSing x)
+  decode (Skip f _) = map (const ()) (decode f)
+  decode (Repeat 0 f) = pure []
+  decode (Repeat (S len) f) = do
+    x <- decode f
+    xs <- decode (Repeat len f)
+    pure (x :: xs)
+  decode (Bind f1 f2) = do
+    x <- decode f1
+    y <- decode (f2 x)
+    pure (x ** y)
 
 
   export
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 735cc5789..ff0693ba2 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -81,26 +81,23 @@ namespace Format
 
 
   export
-  decode : (f : Format) -> Decode (Rep f, ByteStream) ByteStream
-  decode End [] = Just ((), [])
-  decode End (_::_) = Nothing
-  decode Fail _ = Nothing
-  decode (Pure x) buffer =
-    Just (MkSing x, buffer)
-  decode (Skip f _) buffer = do
-    (x, buffer') <- decode f buffer
-    Just ((), buffer')
-  decode (Repeat 0 f) buffer =
-    Just ([], buffer)
-  decode (Repeat (S len) f) buffer = do
-    (x, buffer') <- decode f buffer
-    (xs, buffer'') <- decode (Repeat len f) buffer'
-    Just (x :: xs, buffer'')
-  decode (Bind f1 f2) buffer = do
-    (x, buffer') <- decode f1 buffer
-    (y, buffer'') <- decode (f2 x) buffer'
-    Just ((x ** y), buffer'')
-  decode (Custom f) buffer = f.decode buffer
+  decode : (f : Format) -> DecodePart (Rep f) ByteStream
+  decode End =
+    \case [] => Just ((), [])
+          (_::_) => Nothing
+  decode Fail = const Nothing
+  decode (Pure x) = pure (MkSing x)
+  decode (Skip f _) = map (const ()) (decode f)
+  decode (Repeat 0 f) = pure []
+  decode (Repeat (S len) f) = do
+    x <- decode f
+    xs <- decode (Repeat len f)
+    pure (x :: xs)
+  decode (Bind f1 f2) = do
+    x <- decode f1
+    y <- decode (f2 x)
+    pure (x ** y)
+  decode (Custom f) = f.decode
 
 
   export
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index b221cbb98..c1dfee084 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -29,7 +29,7 @@ public export
 record Format where
   constructor MkFormat
   Rep : Type
-  decode : Decode (Rep, ByteStream) ByteStream
+  decode : DecodePart Rep ByteStream
   encode : Encode Rep ByteStream
 
 
@@ -41,7 +41,7 @@ namespace Format
     Rep : Type
     Rep = Unit
 
-    decode : Decode (Rep, ByteStream) ByteStream
+    decode : DecodePart Rep ByteStream
     decode [] = Just ((), [])
     decode (_::_) = Nothing
 
@@ -55,8 +55,8 @@ namespace Format
     Rep : Type
     Rep = Void
 
-    decode : Decode (Rep, ByteStream) ByteStream
-    decode _ = Nothing
+    decode : DecodePart Rep ByteStream
+    decode = const Nothing
 
     encode : Encode Rep ByteStream
     encode x = void x
@@ -68,8 +68,8 @@ namespace Format
     Rep : Type
     Rep = Sing x
 
-    decode : Decode (Rep, ByteStream) ByteStream
-    decode buffer = Just (MkSing x, buffer)
+    decode : DecodePart Rep ByteStream
+    decode = pure (MkSing x)
 
     encode : Encode Rep ByteStream
     encode (MkSing _) = Just []
@@ -81,10 +81,8 @@ namespace Format
     Rep : Type
     Rep = ()
 
-    decode : Decode (Rep, ByteStream) ByteStream
-    decode buffer = do
-      (x, buffer') <- f.decode buffer
-      Just ((), buffer')
+    decode : DecodePart Rep ByteStream
+    decode = map (const ()) f.decode
 
     encode : Encode Rep ByteStream
     encode () = f.encode def
@@ -96,14 +94,14 @@ namespace Format
     Rep : Type
     Rep = Vect len f.Rep
 
-    decode : Decode (Rep, ByteStream) ByteStream
+    decode : DecodePart Rep ByteStream
     decode = go len where
-      go : (len : Nat) -> Decode (Vect len f.Rep, ByteStream) ByteStream
-      go 0 buffer = Just ([], buffer)
-      go (S len) buffer = do
-        (x, buffer') <- f.decode buffer
-        (xs, buffer'') <- go len buffer'
-        Just (x :: xs, buffer'')
+      go : (len : Nat) -> DecodePart (Vect len f.Rep) ByteStream
+      go 0 = pure []
+      go (S len) = do
+        x <- f.decode
+        xs <- go len
+        pure (x :: xs)
 
     encode : Encode Rep ByteStream
     encode = go len where
@@ -119,11 +117,11 @@ namespace Format
     Rep : Type
     Rep = (x : f1.Rep ** (f2 x).Rep)
 
-    decode : Decode (Rep, ByteStream) ByteStream
-    decode buffer = do
-      (x, buffer') <- f1.decode buffer
-      (y, buffer'') <- (f2 x).decode buffer'
-      Just ((x ** y), buffer'')
+    decode : DecodePart Rep ByteStream
+    decode = do
+      x <- f1.decode
+      y <- (f2 x).decode
+      pure (x ** y)
 
     encode : Encode Rep ByteStream
     encode (x ** y) =
@@ -184,7 +182,7 @@ data FormatOf : (A : Type) -> Type where
 
 namespace FormatOf
 
-  decode : {0 A : Type} -> (f : FormatOf A) -> Decode (A, ByteStream) ByteStream
+  decode : {0 A : Type} -> (f : FormatOf A) -> DecodePart (A) ByteStream
   decode  (MkFormatOf f) = Format.decode f
 
 

From 8f5a720a41bcc2c7f4e45fe19fb454c44b20f222 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 2 Sep 2022 14:24:36 +1000
Subject: [PATCH 33/47] =?UTF-8?q?Rename=20=E2=80=98skip=E2=80=99=20formats?=
 =?UTF-8?q?=20to=20=E2=80=98ignore=E2=80=99?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 experiments/idris/src/Fathom/Base.idr         |  5 ++++
 .../src/Fathom/Closed/IndexedInductive.idr    |  8 ++---
 .../Fathom/Closed/IndexedInductiveCustom.idr  | 10 +++----
 .../src/Fathom/Closed/InductiveRecursive.idr  | 14 ++++-----
 .../Closed/InductiveRecursiveCustom.idr       | 14 ++++-----
 experiments/idris/src/Fathom/Open/Record.idr  | 12 ++++----
 experiments/idris/src/Playground.idr          | 30 +++++++++----------
 7 files changed, 49 insertions(+), 44 deletions(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index 48353e0b0..84752e678 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -83,6 +83,11 @@ namespace DecodePart
     Prelude.map (\(source, target') => (f source, target)) (decode target)
 
 
+  public export
+  ignore :{0 S, T : Type} -> DecodePart S T -> DecodePart () T
+  ignore = map (const ())
+
+
   public export
   bind : {0 S1, S2, T : Type} -> DecodePart S1 T -> (S1 -> DecodePart S2 T) -> DecodePart S2 T
   bind decode1 decode2 target = do
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index 4e8100a71..abec1a96e 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -24,7 +24,7 @@ data FormatOf : Type -> Type where
   End : FormatOf Unit
   Fail : FormatOf Void
   Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
-  Skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  Ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
   Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
   Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
 
@@ -54,7 +54,7 @@ namespace FormatOf
           (_::_) => Nothing
   decode Fail = const Nothing
   decode (Pure x) = pure (MkSing x)
-  decode (Skip f _) = map (const ()) (decode f)
+  decode (Ignore f _) = ignore (decode f)
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) = do
     x <- decode f
@@ -70,7 +70,7 @@ namespace FormatOf
   encode : {0 A, S : Type} -> (f : FormatOf A) -> Encode A (Colist S)
   encode End () = Just []
   encode (Pure x) (MkSing _) = Just []
-  encode (Skip f def) () = encode f def
+  encode (Ignore f def) () = encode f def
   encode (Repeat Z f) [] = Just []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
@@ -182,7 +182,7 @@ namespace Format
 
   public export
   skip : (f : Format) -> (def : f.Rep) -> Format
-  skip f def = MkFormat Unit (Skip (toFormatOf f) def)
+  skip f def = MkFormat Unit (Ignore (toFormatOf f) def)
 
 
   public export
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index 45a45cb62..d1754ba3b 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -37,7 +37,7 @@ data FormatOf : (A : Type) -> Type where
   End : FormatOf Unit
   Fail : FormatOf Void
   Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
-  Skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  Ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
   Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
   Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
   Custom :  (f : CustomFormat) -> FormatOf f.Rep
@@ -68,7 +68,7 @@ namespace FormatOf
           (_::_) => Nothing
   decode Fail = const Nothing
   decode (Pure x) = pure (MkSing x)
-  decode (Skip f _) = map (const ()) (decode f)
+  decode (Ignore f _) = ignore (decode f)
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) = do
     x <- decode f
@@ -85,7 +85,7 @@ namespace FormatOf
   encode : {0 A : Type} -> (f : FormatOf A) -> Encode A ByteStream
   encode End () = Just []
   encode (Pure x) (MkSing _) = Just []
-  encode (Skip f def) () = encode f def
+  encode (Ignore f def) () = encode f def
   encode (Repeat Z f) [] = Just []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
@@ -197,8 +197,8 @@ namespace Format
 
 
   public export
-  skip : (f : Format) -> (def : f.Rep) -> Format
-  skip f def = MkFormat Unit (Skip (toFormatOf f) def)
+  ignore : (f : Format) -> (def : f.Rep) -> Format
+  ignore f def = MkFormat Unit (Ignore (toFormatOf f) def)
 
 
   public export
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 2faaf2540..040d515bd 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -45,7 +45,7 @@ mutual
     End : Format
     Fail : Format
     Pure : {0 A : Type} -> A -> Format
-    Skip : (f : Format) -> (def : Rep f) -> Format
+    Ignore : (f : Format) -> (def : Rep f) -> Format
     Repeat : Nat -> Format -> Format
     Bind : (f : Format) -> (Rep f -> Format) -> Format
 
@@ -55,7 +55,7 @@ mutual
   Rep : Format -> Type
   Rep End = Unit
   Rep Fail = Void
-  Rep (Skip _ _) = Unit
+  Rep (Ignore _ _) = Unit
   Rep (Repeat len f) = Vect len (Rep f)
   Rep (Pure x) = Sing x
   Rep (Bind f1 f2) = (x : Rep f1 ** Rep (f2 x))
@@ -86,7 +86,7 @@ namespace Format
           (_::_) => Nothing
   decode Fail = const Nothing
   decode (Pure x) = pure (MkSing x)
-  decode (Skip f _) = map (const ()) (decode f)
+  decode (Ignore f _) = ignore (decode f)
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) = do
     x <- decode f
@@ -102,7 +102,7 @@ namespace Format
   encode : (f : Format) -> Encode (Rep f) (Colist a)
   encode End () = Just []
   encode (Pure x) (MkSing _) = Just []
-  encode (Skip f def) () = encode f def
+  encode (Ignore f def) () = encode f def
   encode (Repeat Z f) [] = Just []
   encode (Repeat (S len) f) (x :: xs) = do
     [| encode f x <+> encode (Repeat len f) xs |]
@@ -209,9 +209,9 @@ namespace FormatOf
 
 
   public export
-  skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
-  skip f def with (toFormatEq f)
-    skip _ def | (Element f prf) = MkFormatOf (Skip f (rewrite prf in def))
+  ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  ignore f def with (toFormatEq f)
+    ignore _ def | (Element f prf) = MkFormatOf (Ignore f (rewrite prf in def))
 
 
   public export
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index ff0693ba2..31d3aa774 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -44,7 +44,7 @@ mutual
     End : Format
     Fail : Format
     Pure : {0 A : Type} -> A -> Format
-    Skip : (f : Format) -> (def : Rep f) -> Format
+    Ignore : (f : Format) -> (def : Rep f) -> Format
     Repeat : Nat -> Format -> Format
     Bind : (f : Format) -> (Rep f -> Format) -> Format
     Custom :  (f : CustomFormat) -> Format
@@ -55,7 +55,7 @@ mutual
   Rep : Format -> Type
   Rep End = Unit
   Rep Fail = Void
-  Rep (Skip _ _) = Unit
+  Rep (Ignore _ _) = Unit
   Rep (Repeat len f) = Vect len (Rep f)
   Rep (Pure x) = Sing x
   Rep (Bind f1 f2) = (x : Rep f1 ** Rep (f2 x))
@@ -87,7 +87,7 @@ namespace Format
           (_::_) => Nothing
   decode Fail = const Nothing
   decode (Pure x) = pure (MkSing x)
-  decode (Skip f _) = map (const ()) (decode f)
+  decode (Ignore f _) = ignore (decode f)
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) = do
     x <- decode f
@@ -104,7 +104,7 @@ namespace Format
   encode : (f : Format) -> Encode (Rep f) ByteStream
   encode End () = Just []
   encode (Pure x) (MkSing _) = Just []
-  encode (Skip f def) () = encode f def
+  encode (Ignore f def) () = encode f def
   encode (Repeat Z f) [] = Just []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
@@ -244,9 +244,9 @@ namespace FormatOf
 
 
   public export
-  skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
-  skip f def with (toFormatEq f)
-    skip _ def | (Element f prf) = MkFormatOf (Skip f (rewrite prf in def))
+  ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  ignore f def with (toFormatEq f)
+    ignore _ def | (Element f prf) = MkFormatOf (Ignore f (rewrite prf in def))
 
 
   public export
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index c1dfee084..888dd4c57 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -76,13 +76,13 @@ namespace Format
 
 
   public export
-  skip : (f : Format) -> (def : f.Rep) -> Format
-  skip f def = MkFormat { Rep, decode, encode } where
+  ignore : (f : Format) -> (def : f.Rep) -> Format
+  ignore f def = MkFormat { Rep, decode, encode } where
     Rep : Type
     Rep = ()
 
     decode : DecodePart Rep ByteStream
-    decode = map (const ()) f.decode
+    decode = ignore f.decode
 
     encode : Encode Rep ByteStream
     encode () = f.encode def
@@ -268,9 +268,9 @@ namespace FormatOf
 
 
   public export
-  skip : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
-  skip f def with (toFormatEq f)
-    skip _ def | (Element f prf) = MkFormatOf (skip f (rewrite prf in def))
+  ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  ignore f def with (toFormatEq f)
+    ignore _ def | (Element f prf) = MkFormatOf (ignore f (rewrite prf in def))
 
 
   public export
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index ed9127145..eedee36f1 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -45,7 +45,7 @@ formatOf f = Record.MkFormat
 --     End => end.decode
 --     Fail => fail.decode
 --     Pure x => (pure x).decode
---     Skip f def => (skip (format' f) def).decode
+--     Ignore f def => (skip (format' f) def).decode
 --     Repeat len f => (repeat len (format' f)).decode
 --     Bind f1 f2 => (bind (format' f1) (\x => format' (f2 x))).decode
 --     OfSing f r => (format' f).decode
@@ -56,7 +56,7 @@ formatOf f = Record.MkFormat
 --     End => end.encode
 --     Fail => fail.encode
 --     Pure x => (pure x).encode
---     Skip f def => (skip (format' f) def).encode
+--     Ignore f def => (skip (format' f) def).encode
 --     Repeat len f => (repeat len (format' f)).encode
 --     Bind f1 f2 => (bind (format' f1) (\x => format' (f2 x))).encode
 --     OfSing f r => (format' f).encode
@@ -68,7 +68,7 @@ indRecToIndexed : (f : IndRec.Format) -> Indexed.FormatOf (Rep f)
 indRecToIndexed End = Indexed.End
 indRecToIndexed Fail = Indexed.Fail
 indRecToIndexed (Pure x) = Indexed.Pure x
-indRecToIndexed (Skip f def) = Indexed.Skip (indRecToIndexed f) def
+indRecToIndexed (Ignore f def) = Indexed.Ignore (indRecToIndexed f) def
 indRecToIndexed (Repeat len f) = Indexed.Repeat len (indRecToIndexed f)
 indRecToIndexed (Bind f g) = Indexed.Bind (indRecToIndexed f) (\x => indRecToIndexed (g x))
 
@@ -80,8 +80,8 @@ mutual
   indexedToIndRecFormat (MkFormat () End) = (End ** Refl)
   indexedToIndRecFormat (MkFormat Void Fail) = (Fail ** Refl)
   indexedToIndRecFormat (MkFormat (Sing x) (Pure x)) = (Pure x ** Refl)
-  indexedToIndRecFormat (MkFormat () (Skip f def)) with (indexedToIndRecFormatOf f)
-    _ | MkFormatOf f' = (Skip f' def ** Refl)
+  indexedToIndRecFormat (MkFormat () (Ignore f def)) with (indexedToIndRecFormatOf f)
+    _ | MkFormatOf f' = (Ignore f' def ** Refl)
   indexedToIndRecFormat (MkFormat (Vect len _) (Repeat len f)) with (indexedToIndRecFormatOf f)
     _ | MkFormatOf f' = (Repeat len f' ** Refl)
   indexedToIndRecFormat (MkFormat (x : _ ** _) (Bind f1 f2)) with (indexedToIndRecFormatOf f1)
@@ -94,8 +94,8 @@ mutual
   indexedToIndRecFormatOf End = MkFormatOf End
   indexedToIndRecFormatOf Fail = MkFormatOf Fail
   indexedToIndRecFormatOf (Pure x) = MkFormatOf (Pure x)
-  indexedToIndRecFormatOf (Skip f def) with (indexedToIndRecFormatOf f)
-    _ | MkFormatOf f' = MkFormatOf (Skip f' def)
+  indexedToIndRecFormatOf (Ignore f def) with (indexedToIndRecFormatOf f)
+    _ | MkFormatOf f' = MkFormatOf (Ignore f' def)
   indexedToIndRecFormatOf (Repeat len f) with (indexedToIndRecFormatOf f)
     _ | MkFormatOf f' = MkFormatOf (Repeat len f')
   indexedToIndRecFormatOf (Bind f1 f2) with (indexedToIndRecFormatOf f1)
@@ -123,8 +123,8 @@ mutual
 -- indexedToIndRec End = MkFormatOf IndRec.End
 -- indexedToIndRec Fail = MkFormatOf IndRec.Fail
 -- indexedToIndRec (Pure x) = MkFormatOf (IndRec.Pure x)
--- indexedToIndRec (Skip f def) with (indexedToIndRec f)
---   indexedToIndRec (Skip _ def) | MkFormatOf f = MkFormatOf (IndRec.Skip f def)
+-- indexedToIndRec (Ignore f def) with (indexedToIndRec f)
+--   indexedToIndRec (Ignore _ def) | MkFormatOf f = MkFormatOf (IndRec.Ignore f def)
 -- indexedToIndRec (Repeat len f) with (indexedToIndRec f)
 --   indexedToIndRec (Repeat len _) | MkFormatOf f = MkFormatOf (IndRec.Repeat len f)
 -- indexedToIndRec (Bind f1 f2) with (indexedToIndRec f1)
@@ -135,7 +135,7 @@ mutual
   -- _ | (MkFormatOf End) = MkFormatOf (Bind End ?todo_indexedToIndRec_2)
   -- _ | (MkFormatOf Fail) = MkFormatOf (Bind Fail absurd)
   -- _ | (MkFormatOf (Pure f)) = MkFormatOf (Bind ?todo_indexedToIndRec_4)
-  -- _ | (MkFormatOf (Skip f def)) = MkFormatOf (Bind ?todo_indexedToIndRec_5)
+  -- _ | (MkFormatOf (Ignore f def)) = MkFormatOf (Bind ?todo_indexedToIndRec_5)
   -- _ | (MkFormatOf (Repeat k x)) = MkFormatOf (Bind ?todo_indexedToIndRec_6)
   -- _ | (MkFormatOf (Bind f g)) = MkFormatOf (Bind ?todo_indexedToIndRec_7)
 
@@ -164,7 +164,7 @@ mutual
 --   _ | (End ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_2
 --   _ | (Fail ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_3
 --   _ | ((Pure f) ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_4
---   _ | ((Skip f def) ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_5
+--   _ | ((Ignore f def) ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_5
 --   _ | ((Repeat k x) ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_6
 --   _ | ((Bind f g) ** prf) = let bindF1 = Bind f1 in ?todo_indexedToIndRec_7
 
@@ -205,8 +205,8 @@ mutual
 -- indexedToIndRec' End = IndRec.End
 -- indexedToIndRec' Fail = IndRec.Fail
 -- indexedToIndRec' (Pure x) = IndRec.Pure x
--- indexedToIndRec' (Skip f def) with (MkFormatOf (indexedToIndRec' f))
---   _ | f' = IndRec.Skip (indexedToIndRec' f) ?todo1
+-- indexedToIndRec' (Ignore f def) with (MkFormatOf (indexedToIndRec' f))
+--   _ | f' = IndRec.Ignore (indexedToIndRec' f) ?todo1
 -- indexedToIndRec' (Repeat len f) = IndRec.Repeat len (indexedToIndRec' f)
 -- indexedToIndRec' (Bind f1 f2) = IndRec.Bind (indexedToIndRec' f1) ?todo2
 
@@ -215,8 +215,8 @@ mutual
 -- indexedToIndRec'' (MkFormat () End) = IndRec.End
 -- indexedToIndRec'' (MkFormat Void Fail) = IndRec.Fail
 -- indexedToIndRec'' (MkFormat (Sing x) (Pure x)) = IndRec.Pure x
--- indexedToIndRec'' (MkFormat () (Skip f def)) with (indexedToIndRec'' (MkFormat _ f))
---   _ | f'' = IndRec.Skip f'' ?tododef
+-- indexedToIndRec'' (MkFormat () (Ignore f def)) with (indexedToIndRec'' (MkFormat _ f))
+--   _ | f'' = IndRec.Ignore f'' ?tododef
 -- indexedToIndRec'' (MkFormat rep (Repeat len f)) = IndRec.Repeat len (indexedToIndRec'' f)
 -- indexedToIndRec'' (MkFormat rep (Bind f1 f2)) = IndRec.Bind (indexedToIndRec'' f1) ?todo2
 

From 457f25f126da101bd6061f8d2d5ab8ad61f5364e Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 9 Sep 2022 11:44:35 +1000
Subject: [PATCH 34/47] Move typeOf function

---
 experiments/idris/src/Fathom/Base.idr                       | 6 ++++++
 .../idris/src/Fathom/Closed/InductiveRecursiveCustom.idr    | 5 -----
 2 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index 84752e678..d229cf75e 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -7,6 +7,12 @@ import Data.List
 import Data.Vect
 
 
+||| Return the type of an expression, without consuming it
+public export
+typeOf : {1 A : Type} -> (0 x : A) -> Type
+typeOf _ = A
+
+
 ---------------------------
 -- ENCODER/DECODER PAIRS --
 ---------------------------
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 31d3aa774..3a3e9d617 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -14,11 +14,6 @@ import Fathom.Data.Iso
 import Fathom.Data.Sing
 
 
-public export
-typeOf : {1 A : Type} -> (0 x : A) -> Type
-typeOf _ = A
-
-
 -------------------------
 -- FORMAT DESCRIPTIONS --
 -------------------------

From e129a83f7571bbe2402e6e55505b619f7fb7eddc Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Thu, 8 Sep 2022 19:03:03 +1000
Subject: [PATCH 35/47] Ponder compilation a bit

---
 .../OpenType/InductiveRecursive.idr           | 90 +++++++++++++++++++
 1 file changed, 90 insertions(+)

diff --git a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
index 89a78bdd1..e12fd0f23 100644
--- a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
+++ b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
@@ -90,3 +90,93 @@ namespace FormatOf
   simple_glyph = FormatOf.do
     flag <- flag
     pure (flag.repeat + 1)
+
+
+-- Thinking about compilation
+
+namespace Rust
+
+  data RType : Type where
+    Var : String -> RType
+    U8 : RType
+    U16 : RType
+    U32 : RType
+    U64 : RType
+    I8 : RType
+    I16 : RType
+    I32 : RType
+    I64 : RType
+    Never : RType
+    Tuple : List RType -> RType
+    Vec : RType -> RType
+
+  data Item : Type where
+    Struct : List (String, RType) -> Item
+    Enum : List (String, RType) -> Item
+    DecodeFn : () -> Item
+    EncodeFn : () -> Item
+
+  record Module where
+    constructor MkModule
+    items : List (String, Item)
+
+
+namespace Compile
+
+  -- TODO: Cache compilations of definitions
+  --       eg. of structs, enums, endocers and decoders
+
+
+  compileFormat : Format -> (Rust.Module -> Maybe Rust.Module)
+  compileFormat f =
+    -- compile rep
+    -- compile decode
+    -- compile encode
+    ?todo_compileFormat
+
+
+  compileRep : (f : Format) -> Maybe Rust.RType
+  compileRep End = Just (Rust.Tuple [])
+  compileRep Fail = Just (Rust.Never)
+  compileRep (Ignore _ _) = Just (Rust.Tuple [])
+  compileRep (Repeat _ f) =
+    Just (Rust.Vec !(compileRep f)) -- TODO: Compile to a contract? Or maybe a
+                                    --       fixed size array if the length is known
+                                    --       or just throw away the info
+  compileRep (Pure x) =
+    ?todo_compileSingRep -- TODO: interpret an Idris type as a Rust type??
+                         --       perhaps we need to restrict this?
+  compileRep (Bind f1 f2) =
+    Just (Tuple
+      [ !(compileRep f1)
+      , !(compileRep (f2 ?todo_compileBind_x))  -- TODO: how to bind the output?
+                                                --       enum based on the values of `x : Rep f1`?
+                                                --       depends on how `x` is used inside `f2`
+      ])
+  compileRep (Custom f) =
+    -- TODO: f.RustRep
+    Nothing
+
+
+  compileDecode : Format -> (Rust.Module -> Maybe Rust.Module)
+  compileDecode End = ?todo_compileDecodeEnd
+  compileDecode Fail = ?todo_compileDecodeFail
+  compileDecode (Pure x) = ?todo_compileDecodePure
+  compileDecode (Ignore f _) = ?todo_compileDecodeIgnore
+  compileDecode (Repeat len f) = ?todo_compileDecodeRepeat
+  compileDecode (Bind f1 f2) = ?todo_compileDecodeBind
+  compileDecode (Custom f) =
+    -- TODO: f.rustDecode
+    ?todo_compileDecodeCustom
+
+
+  compileEncode : Format -> (Rust.Module -> Maybe Rust.Module)
+  compileEncode End = ?todo_compileEncodeEnd
+  compileEncode Fail = ?todo_compileEncodeFail
+  compileEncode (Pure x) = ?todo_compileEncodePure
+  compileEncode (Ignore f def) = ?todo_compileEncodeIgnore
+  compileEncode (Repeat len f) = ?todo_compileEncodeRepeat
+  compileEncode (Bind f1 f2) = ?todo_compileEncodeBind
+  compileEncode (Custom f) =
+    -- TODO: f.rustEncode
+    ?todo_compileEncodeCustom

From 4e01ddce9fa91235d98fc4733d9a387c69c7fbc6 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 9 Sep 2022 12:51:28 +1000
Subject: [PATCH 36/47] Encode/decode cleanups

---
 .../idris/src/Fathom/Closed/IndexedInductive.idr       |  6 +++---
 .../idris/src/Fathom/Closed/IndexedInductiveCustom.idr |  6 +++---
 .../idris/src/Fathom/Closed/InductiveRecursive.idr     | 10 +++++-----
 .../src/Fathom/Closed/InductiveRecursiveCustom.idr     |  6 +++---
 experiments/idris/src/Fathom/Open/Record.idr           |  4 ++--
 5 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
index abec1a96e..5d2e11de3 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
@@ -68,10 +68,10 @@ namespace FormatOf
 
   export
   encode : {0 A, S : Type} -> (f : FormatOf A) -> Encode A (Colist S)
-  encode End () = Just []
-  encode (Pure x) (MkSing _) = Just []
+  encode End () = pure []
+  encode (Pure x) (MkSing _) = pure []
   encode (Ignore f def) () = encode f def
-  encode (Repeat Z f) [] = Just []
+  encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
   encode (Bind f1 f2) (x ** y) =
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
index d1754ba3b..3def39cf7 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
@@ -83,10 +83,10 @@ namespace FormatOf
 
   export
   encode : {0 A : Type} -> (f : FormatOf A) -> Encode A ByteStream
-  encode End () = Just []
-  encode (Pure x) (MkSing _) = Just []
+  encode End () = pure []
+  encode (Pure x) (MkSing _) = pure []
   encode (Ignore f def) () = encode f def
-  encode (Repeat Z f) [] = Just []
+  encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
   encode (Bind f1 f2) (x ** y) =
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 040d515bd..61ab87165 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -100,13 +100,13 @@ namespace Format
 
   export
   encode : (f : Format) -> Encode (Rep f) (Colist a)
-  encode End () = Just []
-  encode (Pure x) (MkSing _) = Just []
+  encode End () = pure []
+  encode (Pure x) (MkSing _) = pure []
   encode (Ignore f def) () = encode f def
-  encode (Repeat Z f) [] = Just []
-  encode (Repeat (S len) f) (x :: xs) = do
+  encode (Repeat Z f) [] = pure []
+  encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
-  encode (Bind f1 f2) (x ** y) = do
+  encode (Bind f1 f2) (x ** y) =
     [| encode f1 x <+> encode (f2 x) y |]
 
 
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 3a3e9d617..7aee799b7 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -97,10 +97,10 @@ namespace Format
 
   export
   encode : (f : Format) -> Encode (Rep f) ByteStream
-  encode End () = Just []
-  encode (Pure x) (MkSing _) = Just []
+  encode End () = pure []
+  encode (Pure x) (MkSing _) = pure []
   encode (Ignore f def) () = encode f def
-  encode (Repeat Z f) [] = Just []
+  encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
   encode (Bind f1 f2) (x ** y) =
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Open/Record.idr
index 888dd4c57..61cdfff0c 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Open/Record.idr
@@ -72,7 +72,7 @@ namespace Format
     decode = pure (MkSing x)
 
     encode : Encode Rep ByteStream
-    encode (MkSing _) = Just []
+    encode (MkSing _) = pure []
 
 
   public export
@@ -106,7 +106,7 @@ namespace Format
     encode : Encode Rep ByteStream
     encode = go len where
       go : (len : Nat) -> Encode (Vect len f.Rep) ByteStream
-      go 0 [] = Just []
+      go 0 [] = pure []
       go (S len) (x :: xs) =
         [| f.encode x <+> go len xs |]
 

From 8c0dc84883db818efb2565d6f83b7a8e3b066ca5 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 9 Sep 2022 13:19:00 +1000
Subject: [PATCH 37/47] Add field syntax for inductive-recursive reps

---
 .../src/Fathom/Closed/InductiveRecursive.idr  | 30 +++++++++++--------
 .../Closed/InductiveRecursiveCustom.idr       | 30 +++++++++++--------
 experiments/idris/src/Playground.idr          | 12 ++++----
 .../OpenType/InductiveRecursive.idr           |  2 +-
 4 files changed, 43 insertions(+), 31 deletions(-)

diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
index 61ab87165..742da2f20 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
@@ -45,9 +45,9 @@ mutual
     End : Format
     Fail : Format
     Pure : {0 A : Type} -> A -> Format
-    Ignore : (f : Format) -> (def : Rep f) -> Format
+    Ignore : (f : Format) -> (def : f.Rep) -> Format
     Repeat : Nat -> Format -> Format
-    Bind : (f : Format) -> (Rep f -> Format) -> Format
+    Bind : (f : Format) -> (f.Rep -> Format) -> Format
 
 
   ||| The in-memory representation of format descriptions
@@ -56,9 +56,15 @@ mutual
   Rep End = Unit
   Rep Fail = Void
   Rep (Ignore _ _) = Unit
-  Rep (Repeat len f) = Vect len (Rep f)
+  Rep (Repeat len f) = Vect len f.Rep
   Rep (Pure x) = Sing x
-  Rep (Bind f1 f2) = (x : Rep f1 ** Rep (f2 x))
+  Rep (Bind f1 f2) = (x : f1.Rep ** (f2 x).Rep)
+
+
+  ||| Field syntax for representations
+  public export
+  (.Rep) : Format -> Type
+  (.Rep) = Rep
 
 
 namespace Format
@@ -70,7 +76,7 @@ namespace Format
   pure = Pure
 
   public export
-  (>>=) : (f : Format) -> (Rep f -> Format) -> Format
+  (>>=) : (f : Format) -> (f.Rep -> Format) -> Format
   (>>=) = Bind
 
 
@@ -80,7 +86,7 @@ namespace Format
 
 
   export
-  decode : (f : Format) -> DecodePart (Rep f) (Colist a)
+  decode : (f : Format) -> DecodePart f.Rep (Colist a)
   decode End =
     \case [] => Just ((), [])
           (_::_) => Nothing
@@ -99,7 +105,7 @@ namespace Format
 
 
   export
-  encode : (f : Format) -> Encode (Rep f) (Colist a)
+  encode : (f : Format) -> Encode f.Rep (Colist a)
   encode End () = pure []
   encode (Pure x) (MkSing _) = pure []
   encode (Ignore f def) () = encode f def
@@ -118,7 +124,7 @@ namespace Format
 ||| A format description refined with a fixed representation
 public export
 data FormatOf : (A : Type) -> Type where
-  MkFormatOf : (f : Format) -> FormatOf (Rep f)
+  MkFormatOf : (f : Format) -> FormatOf f.Rep
 
 
 namespace FormatOf
@@ -139,14 +145,14 @@ namespace FormatOf
 namespace Format
 
   public export
-  toFormatOf : (f : Format) -> FormatOf (Rep f)
+  toFormatOf : (f : Format) -> FormatOf f.Rep
   toFormatOf f = MkFormatOf f
 
 
   ||| Convert a format description into an indexed format description with an
   ||| equality proof that the representation is the same as the index.
   public export
-  toFormatOfEq : {0 A : Type} -> (Subset Format (\f => Rep f = A)) -> FormatOf A
+  toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
   toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
 
 
@@ -160,7 +166,7 @@ namespace FormatOf
   ||| Convert an indexed format description to a existential format description,
   ||| along with a proof that the representation is the same as the index.
   public export
-  toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => Rep f = A))
+  toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
   toFormatEq (MkFormatOf f) = Element f Refl
 
 
@@ -175,7 +181,7 @@ toFormatOfIso = MkIso
 
 
 public export
-toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => Rep f = a)))) (Exists FormatOf)
+toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => f.Rep = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
   { to = \(Evidence _ f) => Evidence _ (toFormatOfEq f)
   , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
index 7aee799b7..4e676a3bd 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
@@ -39,9 +39,9 @@ mutual
     End : Format
     Fail : Format
     Pure : {0 A : Type} -> A -> Format
-    Ignore : (f : Format) -> (def : Rep f) -> Format
+    Ignore : (f : Format) -> (def : f.Rep) -> Format
     Repeat : Nat -> Format -> Format
-    Bind : (f : Format) -> (Rep f -> Format) -> Format
+    Bind : (f : Format) -> (f.Rep -> Format) -> Format
     Custom :  (f : CustomFormat) -> Format
 
 
@@ -51,12 +51,18 @@ mutual
   Rep End = Unit
   Rep Fail = Void
   Rep (Ignore _ _) = Unit
-  Rep (Repeat len f) = Vect len (Rep f)
+  Rep (Repeat len f) = Vect len f.Rep
   Rep (Pure x) = Sing x
-  Rep (Bind f1 f2) = (x : Rep f1 ** Rep (f2 x))
+  Rep (Bind f1 f2) = (x : f1.Rep ** (f2 x).Rep)
   Rep (Custom f) = f.Rep
 
 
+  ||| Field syntax for representations
+  public export
+  (.Rep) : Format -> Type
+  (.Rep) = Rep
+
+
 namespace Format
 
   -- Support for do notation
@@ -66,7 +72,7 @@ namespace Format
   pure = Pure
 
   public export
-  (>>=) : (f : Format) -> (Rep f -> Format) -> Format
+  (>>=) : (f : Format) -> (f.Rep -> Format) -> Format
   (>>=) = Bind
 
 
@@ -76,7 +82,7 @@ namespace Format
 
 
   export
-  decode : (f : Format) -> DecodePart (Rep f) ByteStream
+  decode : (f : Format) -> DecodePart f.Rep ByteStream
   decode End =
     \case [] => Just ((), [])
           (_::_) => Nothing
@@ -96,7 +102,7 @@ namespace Format
 
 
   export
-  encode : (f : Format) -> Encode (Rep f) ByteStream
+  encode : (f : Format) -> Encode f.Rep ByteStream
   encode End () = pure []
   encode (Pure x) (MkSing _) = pure []
   encode (Ignore f def) () = encode f def
@@ -148,7 +154,7 @@ namespace Format
 ||| A format description indexed with a fixed representation
 public export
 data FormatOf : (Rep : Type) -> Type where
-  MkFormatOf : (f : Format) -> FormatOf (Rep f)
+  MkFormatOf : (f : Format) -> FormatOf f.Rep
 
 
 namespace FormatOf
@@ -169,14 +175,14 @@ namespace FormatOf
 namespace Format
 
   public export
-  toFormatOf : (f : Format) -> FormatOf (Rep f)
+  toFormatOf : (f : Format) -> FormatOf f.Rep
   toFormatOf f = MkFormatOf f
 
 
   ||| Convert a format description into an indexed format description with an
   ||| equality proof that the representation is the same as the index.
   public export
-  toFormatOfEq : {0 A : Type} -> (Subset Format (\f => Rep f = A)) -> FormatOf A
+  toFormatOfEq : {0 A : Type} -> (Subset Format (\f => f.Rep = A)) -> FormatOf A
   toFormatOfEq (Element f prf) = rewrite sym prf in MkFormatOf f
 
 
@@ -190,7 +196,7 @@ namespace FormatOf
   ||| Convert an indexed format description to a existential format description,
   ||| along with a proof that the representation is the same as the index.
   public export
-  toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => Rep f = A))
+  toFormatEq : {0 A : Type} -> FormatOf A -> (Subset Format (\f => f.Rep = A))
   toFormatEq (MkFormatOf f) = Element f Refl
 
 
@@ -205,7 +211,7 @@ toFormatOfIso = MkIso
 
 
 public export
-toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => Rep f = a)))) (Exists FormatOf)
+toFormatOfEqIso : Iso (Exists (\a => (Subset Format (\f => f.Rep = a)))) (Exists FormatOf)
 toFormatOfEqIso = MkIso
   { to = \(Evidence _ f) => Evidence _ (toFormatOfEq f)
   , from = \(Evidence _ f) => Evidence _ (toFormatEq f)
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index eedee36f1..1f6dd96b1 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -18,7 +18,7 @@ import Fathom.Open.Record as Record
 public export
 format : IndRec.Format -> Record.Format
 format f = Record.MkFormat
-  { Rep = Rep f
+  { Rep = f.Rep
   , decode = decode f
   , encode = encode f
   }
@@ -64,7 +64,7 @@ formatOf f = Record.MkFormat
 
 
 ||| Convert an inductive-recursive format description to an indexed format
-indRecToIndexed : (f : IndRec.Format) -> Indexed.FormatOf (Rep f)
+indRecToIndexed : (f : IndRec.Format) -> Indexed.FormatOf f.Rep
 indRecToIndexed End = Indexed.End
 indRecToIndexed Fail = Indexed.Fail
 indRecToIndexed (Pure x) = Indexed.Pure x
@@ -76,7 +76,7 @@ indRecToIndexed (Bind f g) = Indexed.Bind (indRecToIndexed f) (\x => indRecToInd
 mutual
 
   ||| Convert an indexed format description to an inductive-recursive format
-  indexedToIndRecFormat : (f : Indexed.Format) -> (f' : IndRec.Format ** Rep f = Rep f')
+  indexedToIndRecFormat : (f : Indexed.Format) -> (f' : IndRec.Format ** f.Rep = f'.Rep)
   indexedToIndRecFormat (MkFormat () End) = (End ** Refl)
   indexedToIndRecFormat (MkFormat Void Fail) = (Fail ** Refl)
   indexedToIndRecFormat (MkFormat (Sing x) (Pure x)) = (Pure x ** Refl)
@@ -150,8 +150,8 @@ mutual
 --   indexedToIndRec (Bind _ f2) | MkFormatOf f1 =
 --     let
 --       bindF1 = Bind f1
---       bodyF2 : x : Rep f1 -> FormatOf ()
---       bodyF2 = x : Rep f1 =>
+--       bodyF2 : x : f1.Rep -> FormatOf ()
+--       bodyF2 = x : f1.Rep =>
 --         case sameRep (indexedToIndRec (f2 x)) of
 --           (f2' ** prf) => f2')
 --     in
@@ -188,7 +188,7 @@ mutual
 --     in
 --     --    f1 : Format
 --     --  0 A : Type
---     --    f2 : (x : Rep f1) -> FormatOf (B x)
+--     --    f2 : (x : f1.Rep) -> FormatOf (B x)
 --     -- ------------------------------
 --     -- todo_indexedToIndRec : FormatOf (DPair (Rep f1) (\x => B x))
     -- ?todo_indexedToIndRec
diff --git a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
index e12fd0f23..5593e77a6 100644
--- a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
+++ b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
@@ -25,7 +25,7 @@ namespace Format
     Pure ()
 
 
-  (.repeat) : Rep Format.flag -> Nat
+  (.repeat) : Format.flag.Rep -> Nat
   (.repeat) (0 ** repeat ** _) = repeat
   (.repeat) (S _ ** repeat ** _) = val repeat
 

From 0d01ee2b9ef8548a8a03c1e4d92e2f907310bacd Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 9 Sep 2022 13:35:26 +1000
Subject: [PATCH 38/47] Move format descriptions under single path

---
 experiments/idris/fathom.ipkg                         | 11 +++++------
 experiments/idris/src/Fathom.idr                      |  8 ++++----
 .../Fathom/{Closed => Format}/IndexedInductive.idr    |  2 +-
 .../{Closed => Format}/IndexedInductiveCustom.idr     |  4 ++--
 .../Fathom/{Closed => Format}/InductiveRecursive.idr  |  4 +---
 .../{Closed => Format}/InductiveRecursiveCustom.idr   |  4 ++--
 .../idris/src/Fathom/{Open => Format}/Record.idr      |  2 +-
 experiments/idris/src/Playground.idr                  |  6 +++---
 .../src/Playground/OpenType/IndexedInductive.idr      |  2 +-
 .../src/Playground/OpenType/InductiveRecursive.idr    |  2 +-
 experiments/idris/src/Playground/OpenType/Record.idr  |  2 +-
 11 files changed, 22 insertions(+), 25 deletions(-)
 rename experiments/idris/src/Fathom/{Closed => Format}/IndexedInductive.idr (99%)
 rename experiments/idris/src/Fathom/{Closed => Format}/IndexedInductiveCustom.idr (97%)
 rename experiments/idris/src/Fathom/{Closed => Format}/InductiveRecursive.idr (98%)
 rename experiments/idris/src/Fathom/{Closed => Format}/InductiveRecursiveCustom.idr (98%)
 rename experiments/idris/src/Fathom/{Open => Format}/Record.idr (99%)

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index e7405564b..00b49fc14 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -20,12 +20,11 @@ modules = Fathom
         , Fathom.Data.Iso
         , Fathom.Data.Sing
         , Fathom.Data.Word
-
-        , Fathom.Closed.IndexedInductive
-        , Fathom.Closed.IndexedInductiveCustom
-        , Fathom.Closed.InductiveRecursive
-        , Fathom.Closed.InductiveRecursiveCustom
-        , Fathom.Open.Record
+        , Fathom.Format.IndexedInductive
+        , Fathom.Format.IndexedInductiveCustom
+        , Fathom.Format.InductiveRecursive
+        , Fathom.Format.InductiveRecursiveCustom
+        , Fathom.Format.Record
 
         , Playground
         , Playground.OpenType.IndexedInductive
diff --git a/experiments/idris/src/Fathom.idr b/experiments/idris/src/Fathom.idr
index c998deac1..5c4e3d434 100644
--- a/experiments/idris/src/Fathom.idr
+++ b/experiments/idris/src/Fathom.idr
@@ -1,7 +1,7 @@
 ||| A sketch of core Fathom in Idris 2
 
 import public Fathom.Base
-import public Fathom.Closed.IndexedInductive
-import public Fathom.Closed.InductiveRecursive
-import public Fathom.Closed.InductiveRecursiveCustom
-import public Fathom.Open.Record
+import public Fathom.Format.IndexedInductive
+import public Fathom.Format.InductiveRecursive
+import public Fathom.Format.InductiveRecursiveCustom
+import public Fathom.Format.Record
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr b/experiments/idris/src/Fathom/Format/IndexedInductive.idr
similarity index 99%
rename from experiments/idris/src/Fathom/Closed/IndexedInductive.idr
rename to experiments/idris/src/Fathom/Format/IndexedInductive.idr
index 5d2e11de3..d270c195a 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductive.idr
@@ -1,7 +1,7 @@
 ||| A closed universe of format descriptions as an inductive type, where the
 ||| in-memory representation is tracked as an index on the type.
 
-module Fathom.Closed.IndexedInductive
+module Fathom.Format.IndexedInductive
 
 
 import Data.Colist
diff --git a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
similarity index 97%
rename from experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
rename to experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
index 3def39cf7..5847a2f28 100644
--- a/experiments/idris/src/Fathom/Closed/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
@@ -1,7 +1,7 @@
 ||| A closed universe of format descriptions as an inductive type, where the
 ||| in-memory representation is tracked as an index on the type.
 
-module Fathom.Closed.IndexedInductiveCustom
+module Fathom.Format.IndexedInductiveCustom
 
 
 import Data.Colist
@@ -20,7 +20,7 @@ import Fathom.Data.Sing
 
 ||| A custom format description.
 |||
-||| We’d prefer to just import `Fathom.Open.Record`, but Idris’ imports are a
+||| We’d prefer to just import `Fathom.Format.Record`, but Idris’ imports are a
 ||| bit temperamental and result in ambiguities when importing modules that
 ||| contain types of the same name as those defined in the current module.
 public export
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr b/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
similarity index 98%
rename from experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
rename to experiments/idris/src/Fathom/Format/InductiveRecursive.idr
index 742da2f20..56cb6c52d 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
@@ -19,7 +19,7 @@
 ||| Inspiration for this approach is taken from [“The Power of Pi”](https://cs.ru.nl/~wouters/Publications/ThePowerOfPi.pdf)
 ||| by Oury and Swierstra.
 
-module Fathom.Closed.InductiveRecursive
+module Fathom.Format.InductiveRecursive
 
 
 import Data.Colist
@@ -30,8 +30,6 @@ import Fathom.Base
 import Fathom.Data.Iso
 import Fathom.Data.Sing
 
--- import Fathom.Open.Record
-
 
 -------------------------
 -- FORMAT DESCRIPTIONS --
diff --git a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
similarity index 98%
rename from experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
rename to experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
index 4e676a3bd..a24276d22 100644
--- a/experiments/idris/src/Fathom/Closed/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
@@ -1,7 +1,7 @@
 ||| Experimenting with an approach to extending inductive-recursive format
 ||| descriptions with custom formats.
 
-module Fathom.Closed.InductiveRecursiveCustom
+module Fathom.Format.InductiveRecursiveCustom
 
 
 import Data.Bits
@@ -21,7 +21,7 @@ import Fathom.Data.Sing
 
 ||| A custom format description.
 |||
-||| We’d prefer to just import `Fathom.Open.Record`, but Idris’ imports are a
+||| We’d prefer to just import `Fathom.Format.Record`, but Idris’ imports are a
 ||| bit temperamental and result in ambiguities when importing modules that
 ||| contain types of the same name as those defined in the current module.
 public export
diff --git a/experiments/idris/src/Fathom/Open/Record.idr b/experiments/idris/src/Fathom/Format/Record.idr
similarity index 99%
rename from experiments/idris/src/Fathom/Open/Record.idr
rename to experiments/idris/src/Fathom/Format/Record.idr
index 61cdfff0c..5996bc5d3 100644
--- a/experiments/idris/src/Fathom/Open/Record.idr
+++ b/experiments/idris/src/Fathom/Format/Record.idr
@@ -8,7 +8,7 @@
 ||| universes’ that [some type theorists were proposing](https://www.cmu.edu/dietrich/philosophy/hott/slides/shulman-2022-05-12.pdf#page=79),
 ||| but I may be mistaken.
 
-module Fathom.Open.Record
+module Fathom.Format.Record
 
 
 import Data.Colist
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index 1f6dd96b1..4c52c977a 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -6,9 +6,9 @@ import Data.Vect
 
 import Fathom.Base
 import Fathom.Data.Sing
-import Fathom.Closed.InductiveRecursive as IndRec
-import Fathom.Closed.IndexedInductive as Indexed
-import Fathom.Open.Record as Record
+import Fathom.Format.InductiveRecursive as IndRec
+import Fathom.Format.IndexedInductive as Indexed
+import Fathom.Format.Record as Record
 
 
 -- Experiment with converting between the different styles of format universes
diff --git a/experiments/idris/src/Playground/OpenType/IndexedInductive.idr b/experiments/idris/src/Playground/OpenType/IndexedInductive.idr
index 23454e5ed..53d3d20c9 100644
--- a/experiments/idris/src/Playground/OpenType/IndexedInductive.idr
+++ b/experiments/idris/src/Playground/OpenType/IndexedInductive.idr
@@ -4,7 +4,7 @@ module Playground.OpenType.IndexedInductive
 
 
 import Fathom.Data.Sing
-import Fathom.Closed.IndexedInductiveCustom
+import Fathom.Format.IndexedInductiveCustom
 
 
 namespace FormatOf
diff --git a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
index 5593e77a6..c35a1c72b 100644
--- a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
+++ b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
@@ -4,7 +4,7 @@ module Playground.OpenType.InductiveRecursive
 
 
 import Fathom.Data.Sing
-import Fathom.Closed.InductiveRecursiveCustom
+import Fathom.Format.InductiveRecursiveCustom
 
 
 namespace Format
diff --git a/experiments/idris/src/Playground/OpenType/Record.idr b/experiments/idris/src/Playground/OpenType/Record.idr
index 4cfe6c82b..c9bdce4da 100644
--- a/experiments/idris/src/Playground/OpenType/Record.idr
+++ b/experiments/idris/src/Playground/OpenType/Record.idr
@@ -4,7 +4,7 @@ module Playground.OpenType.Record
 
 
 import Fathom.Data.Sing
-import Fathom.Open.Record
+import Fathom.Format.Record
 
 
 namespace Format

From 0f475d31f2d154a29c2e11b8491c065f644654b5 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Fri, 9 Sep 2022 15:37:22 +1000
Subject: [PATCH 39/47] Add pair formats

---
 .../src/Fathom/Format/IndexedInductive.idr    | 12 +++++++++
 .../Fathom/Format/IndexedInductiveCustom.idr  | 12 +++++++++
 .../src/Fathom/Format/InductiveRecursive.idr  | 16 ++++++++++++
 .../Format/InductiveRecursiveCustom.idr       | 16 ++++++++++++
 .../idris/src/Fathom/Format/Record.idr        | 25 +++++++++++++++++++
 experiments/idris/src/Playground.idr          |  5 ++++
 .../OpenType/InductiveRecursive.idr           |  7 ++++++
 7 files changed, 93 insertions(+)

diff --git a/experiments/idris/src/Fathom/Format/IndexedInductive.idr b/experiments/idris/src/Fathom/Format/IndexedInductive.idr
index d270c195a..d4fd40e59 100644
--- a/experiments/idris/src/Fathom/Format/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductive.idr
@@ -26,6 +26,7 @@ data FormatOf : Type -> Type where
   Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
   Ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
   Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
+  Pair : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (A, B)
   Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
 
 
@@ -60,6 +61,10 @@ namespace FormatOf
     x <- decode f
     xs <- decode (Repeat len f)
     pure (x :: xs)
+  decode (Pair f1 f2) = do
+    x <- decode f1
+    y <- decode f2
+    pure (x, y)
   decode (Bind f1 f2) = do
     x <- decode f1
     y <- decode (f2 x)
@@ -74,6 +79,8 @@ namespace FormatOf
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Pair f1 f2) (x, y) =
+    [| encode f1 x <+> encode f2 y |]
   encode (Bind f1 f2) (x ** y) =
     [| encode f1 x <+> encode (f2 x) y |]
 
@@ -190,6 +197,11 @@ namespace Format
   repeat len f = MkFormat (Vect len f.Rep) (Repeat len (toFormatOf f))
 
 
+  public export
+  pair : Format -> Format -> Format
+  pair f1 f2 = MkFormat (f1.Rep, f2.Rep) (Pair (toFormatOf f1) (toFormatOf f2))
+
+
   public export
   bind : (f : Format) -> (Rep f -> Format) -> Format
   bind f1 f2 =
diff --git a/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
index 5847a2f28..27c1ff0e5 100644
--- a/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
@@ -39,6 +39,7 @@ data FormatOf : (A : Type) -> Type where
   Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
   Ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
   Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
+  Pair : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (A, B)
   Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
   Custom :  (f : CustomFormat) -> FormatOf f.Rep
 
@@ -74,6 +75,10 @@ namespace FormatOf
     x <- decode f
     xs <- decode (Repeat len f)
     pure (x :: xs)
+  decode (Pair f1 f2) = do
+    x <- decode f1
+    y <- decode f2
+    pure (x, y)
   decode (Bind f1 f2) = do
     x <- decode f1
     y <- decode (f2 x)
@@ -89,6 +94,8 @@ namespace FormatOf
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Pair f1 f2) (x, y) =
+    [| encode f1 x <+> encode f2 y |]
   encode (Bind f1 f2) (x ** y) =
     [| encode f1 x <+> encode (f2 x) y |]
   encode (Custom f) x = f.encode x
@@ -206,6 +213,11 @@ namespace Format
   repeat len f = MkFormat (Vect len f.Rep) (Repeat len (toFormatOf f))
 
 
+  public export
+  pair : Format -> Format -> Format
+  pair f1 f2 = MkFormat (f1.Rep, f2.Rep) (Pair (toFormatOf f1) (toFormatOf f2))
+
+
   public export
   bind : (f : Format) -> (Rep f -> Format) -> Format
   bind f1 f2 =
diff --git a/experiments/idris/src/Fathom/Format/InductiveRecursive.idr b/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
index 56cb6c52d..b3c937e96 100644
--- a/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
@@ -45,6 +45,7 @@ mutual
     Pure : {0 A : Type} -> A -> Format
     Ignore : (f : Format) -> (def : f.Rep) -> Format
     Repeat : Nat -> Format -> Format
+    Pair : Format -> Format -> Format
     Bind : (f : Format) -> (f.Rep -> Format) -> Format
 
 
@@ -56,6 +57,7 @@ mutual
   Rep (Ignore _ _) = Unit
   Rep (Repeat len f) = Vect len f.Rep
   Rep (Pure x) = Sing x
+  Rep (Pair f1 f2) = (f1.Rep, f2.Rep)
   Rep (Bind f1 f2) = (x : f1.Rep ** (f2 x).Rep)
 
 
@@ -96,6 +98,10 @@ namespace Format
     x <- decode f
     xs <- decode (Repeat len f)
     pure (x :: xs)
+  decode (Pair f1 f2) = do
+    x <- decode f1
+    y <- decode f2
+    pure (x, y)
   decode (Bind f1 f2) = do
     x <- decode f1
     y <- decode (f2 x)
@@ -110,6 +116,8 @@ namespace Format
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Pair f1 f2) (x, y) =
+    [| encode f1 x <+> encode f2 y |]
   encode (Bind f1 f2) (x ** y) =
     [| encode f1 x <+> encode (f2 x) y |]
 
@@ -225,6 +233,14 @@ namespace FormatOf
       toFormatOfEq (Element (Repeat len f) (cong (Vect len) prf))
 
 
+  public export
+  pair : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (A, B)
+  pair f1 f2 with (toFormatEq f1, toFormatEq f2)
+    pair _ _ | (Element f1 prf1, Element f2 prf2) =
+      toFormatOfEq (Element (Pair f1 f2)
+        (rewrite prf1 in rewrite prf2 in Refl))
+
+
   public export
   bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
   bind f1 f2 with (toFormatEq f1)
diff --git a/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
index a24276d22..357476348 100644
--- a/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
@@ -41,6 +41,7 @@ mutual
     Pure : {0 A : Type} -> A -> Format
     Ignore : (f : Format) -> (def : f.Rep) -> Format
     Repeat : Nat -> Format -> Format
+    Pair : Format -> Format -> Format
     Bind : (f : Format) -> (f.Rep -> Format) -> Format
     Custom :  (f : CustomFormat) -> Format
 
@@ -53,6 +54,7 @@ mutual
   Rep (Ignore _ _) = Unit
   Rep (Repeat len f) = Vect len f.Rep
   Rep (Pure x) = Sing x
+  Rep (Pair f1 f2) = (f1.Rep, f2.Rep)
   Rep (Bind f1 f2) = (x : f1.Rep ** (f2 x).Rep)
   Rep (Custom f) = f.Rep
 
@@ -94,6 +96,10 @@ namespace Format
     x <- decode f
     xs <- decode (Repeat len f)
     pure (x :: xs)
+  decode (Pair f1 f2) = do
+    x <- decode f1
+    y <- decode f2
+    pure (x, y)
   decode (Bind f1 f2) = do
     x <- decode f1
     y <- decode (f2 x)
@@ -109,6 +115,8 @@ namespace Format
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Pair f1 f2) (x, y) =
+    [| encode f1 x <+> encode f2 y |]
   encode (Bind f1 f2) (x ** y) =
     [| encode f1 x <+> encode (f2 x) y |]
   encode (Custom f) x = f.encode x
@@ -257,6 +265,14 @@ namespace FormatOf
       toFormatOfEq (Element (Repeat len f) (cong (Vect len) prf))
 
 
+  public export
+  pair : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (A, B)
+  pair f1 f2 with (toFormatEq f1, toFormatEq f2)
+    pair _ _ | (Element f1 prf1, Element f2 prf2) =
+      toFormatOfEq (Element (Pair f1 f2)
+        (rewrite prf1 in rewrite prf2 in Refl))
+
+
   public export
   bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
   bind f1 f2 with (toFormatEq f1)
diff --git a/experiments/idris/src/Fathom/Format/Record.idr b/experiments/idris/src/Fathom/Format/Record.idr
index 5996bc5d3..20426a116 100644
--- a/experiments/idris/src/Fathom/Format/Record.idr
+++ b/experiments/idris/src/Fathom/Format/Record.idr
@@ -111,6 +111,23 @@ namespace Format
         [| f.encode x <+> go len xs |]
 
 
+  public export
+  pair : Format -> Format -> Format
+  pair f1 f2 = MkFormat { Rep, decode, encode } where
+    Rep : Type
+    Rep = (f1.Rep, f2.Rep)
+
+    decode : DecodePart Rep ByteStream
+    decode = do
+      x <- f1.decode
+      y <- f2.decode
+      pure (x, y)
+
+    encode : Encode Rep ByteStream
+    encode (x, y) =
+      [| f1.encode x <+> f2.encode y |]
+
+
   public export
   bind : (f : Format) -> (f.Rep -> Format) -> Format
   bind f1 f2 = MkFormat { Rep, decode, encode } where
@@ -280,6 +297,14 @@ namespace FormatOf
       toFormatOfEq (Element (repeat len f) (cong (Vect len) prf))
 
 
+  public export
+  pair : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (A, B)
+  pair f1 f2 with (toFormatEq f1, toFormatEq f2)
+    pair _ _ | (Element f1 prf1, Element f2 prf2) =
+      toFormatOfEq (Element (pair f1 f2)
+        (rewrite prf1 in rewrite prf2 in Refl))
+
+
   public export
   bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
   bind f1 f2 with (toFormatEq f1)
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index 4c52c977a..9dc1983a4 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -70,6 +70,7 @@ indRecToIndexed Fail = Indexed.Fail
 indRecToIndexed (Pure x) = Indexed.Pure x
 indRecToIndexed (Ignore f def) = Indexed.Ignore (indRecToIndexed f) def
 indRecToIndexed (Repeat len f) = Indexed.Repeat len (indRecToIndexed f)
+indRecToIndexed (Pair f1 f2) = Indexed.Pair (indRecToIndexed f1) (indRecToIndexed f2)
 indRecToIndexed (Bind f g) = Indexed.Bind (indRecToIndexed f) (\x => indRecToIndexed (g x))
 
 
@@ -84,6 +85,8 @@ mutual
     _ | MkFormatOf f' = (Ignore f' def ** Refl)
   indexedToIndRecFormat (MkFormat (Vect len _) (Repeat len f)) with (indexedToIndRecFormatOf f)
     _ | MkFormatOf f' = (Repeat len f' ** Refl)
+  indexedToIndRecFormat (MkFormat (_, _) (Pair f1 f2)) with (indexedToIndRecFormatOf f1, indexedToIndRecFormatOf f2)
+    _ | (MkFormatOf f1', MkFormatOf f2') = (Pair f1' f2' ** Refl)
   indexedToIndRecFormat (MkFormat (x : _ ** _) (Bind f1 f2)) with (indexedToIndRecFormatOf f1)
     _ | MkFormatOf f1' =
       (Bind f1' (\x => ?indexedToIndRecFormatBind_f2) ** ?todoBindPrf)
@@ -98,6 +101,8 @@ mutual
     _ | MkFormatOf f' = MkFormatOf (Ignore f' def)
   indexedToIndRecFormatOf (Repeat len f) with (indexedToIndRecFormatOf f)
     _ | MkFormatOf f' = MkFormatOf (Repeat len f')
+  indexedToIndRecFormatOf (Pair f1 f2) with (indexedToIndRecFormatOf f1, indexedToIndRecFormatOf f2)
+    _ | (MkFormatOf f1', MkFormatOf f2') = MkFormatOf (Pair f1' f2')
   indexedToIndRecFormatOf (Bind f1 f2) with (indexedToIndRecFormatOf f1)
     _ | MkFormatOf f1' =
   --     -- let
diff --git a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
index c35a1c72b..bfa65c392 100644
--- a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
+++ b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
@@ -146,6 +146,11 @@ namespace Compile
   compileRep (Pure x) =
     ?todo_compileSingRep -- TODO: interpret an Idris type as a Rust type??
                          --       perhaps we need to restrict this?
+  compileRep (Pair f1 f2) =
+    Just (Rust.Tuple
+      [ !(compileRep f1)
+      , !(compileRep f2)
+      ])
   compileRep (Bind f1 f2) =
     Just (Tuple
       [ !(compileRep f1)
@@ -164,6 +169,7 @@ namespace Compile
   compileDecode (Pure x) = ?todo_compileDecodePure
   compileDecode (Ignore f _) = ?todo_compileDecodeIgnore
   compileDecode (Repeat len f) = ?todo_compileDecodeRepeat
+  compileDecode (Pair f1 f2) = ?todo_compileDecodePair
   compileDecode (Bind f1 f2) = ?todo_compileDecodeBind
   compileDecode (Custom f) =
     -- TODO: f.rustDecode
@@ -176,6 +182,7 @@ namespace Compile
   compileEncode (Pure x) = ?todo_compileEncodePure
   compileEncode (Ignore f def) = ?todo_compileEncodeIgnore
   compileEncode (Repeat len f) = ?todo_compileEncodeRepeat
+  compileEncode (Pair f1 f2) = ?todo_compileEncodePair
   compileEncode (Bind f1 f2) = ?todo_compileEncodeBind
   compileEncode (Custom f) =
     -- TODO: f.rustEncode

From d11c5d47f3f69161ce7377489a2efcafaaf3b4c9 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Sat, 3 Sep 2022 11:07:25 +1000
Subject: [PATCH 40/47] Enable applicative notation for decoders

---
 experiments/idris/src/Fathom/Base.idr         | 54 +++++++++++--------
 .../src/Fathom/Format/IndexedInductive.idr    | 12 ++---
 .../Fathom/Format/IndexedInductiveCustom.idr  | 12 ++---
 .../src/Fathom/Format/InductiveRecursive.idr  | 12 ++---
 .../Format/InductiveRecursiveCustom.idr       | 12 ++---
 .../idris/src/Fathom/Format/Record.idr        | 14 ++---
 6 files changed, 51 insertions(+), 65 deletions(-)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index d229cf75e..a98ce37b5 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -73,24 +73,51 @@ parameters (Source, Target : Type)
   EncodePart = Encode (Source, Target) Target
 
 
+parameters {0 Source, Target : Type}
+
+  public export
+  toDecodeFull : (Monoid Target, Eq Target) => DecodePart Source Target -> Decode Source Target
+  toDecodeFull decode target = Prelude.do
+    (source, target') <- decode target
+    if target == neutral then Just source else Nothing
+
+
+  public export
+  toEncodeFull : Monoid Target => EncodePart Source Target -> Encode Source Target
+  toEncodeFull encode source = encode (source, neutral)
+
+
+  public export
+  toEncodePart : Monoid Target => Encode Source Target -> EncodePart Source Target
+  toEncodePart encode (source, target) = [| encode source <+> Just target |]
+
+
 namespace DecodePart
 
   -- TODO: Should probably implement functor, applicative, or monad here. or use
   -- the reader, writer or state monad transformers
 
+  public export
+  map : {0 S1, S2, T : Type} -> (S1 -> S2) -> DecodePart S1 T -> DecodePart S2 T
+  map f decode target =
+    Prelude.map (\(source, target') => (f source, target)) (decode target)
+
+
   public export
   pure : {0 S, T : Type} -> S -> DecodePart S T
   pure source target = Just (source, target)
 
 
   public export
-  map : {0 S1, S2, T : Type} -> (S1 -> S2) -> DecodePart S1 T -> DecodePart S2 T
-  map f decode target =
-    Prelude.map (\(source, target') => (f source, target)) (decode target)
+  (<*>) : {0 S1, S2, T : Type} -> DecodePart (S1 -> S2) T -> DecodePart S1 T -> DecodePart S2 T
+  (<*>) decodeFun decode target = do
+    (fun, target1) <- decodeFun target
+    (source, target2) <- decode target1
+    Just (fun source, target2)
 
 
   public export
-  ignore :{0 S, T : Type} -> DecodePart S T -> DecodePart () T
+  ignore : {0 S, T : Type} -> DecodePart S T -> DecodePart () T
   ignore = map (const ())
 
 
@@ -106,25 +133,6 @@ namespace DecodePart
   (>>=) = bind
 
 
-parameters {0 Source, Target : Type}
-
-  public export
-  toDecodeFull : (Monoid Target, Eq Target) => DecodePart Source Target -> Decode Source Target
-  toDecodeFull decode target = Prelude.do
-    (source, target') <- decode target
-    if target == neutral then Just source else Nothing
-
-
-  public export
-  toEncodeFull : Monoid Target => EncodePart Source Target -> Encode Source Target
-  toEncodeFull encode source = encode (source, neutral)
-
-
-  public export
-  toEncodePart : Monoid Target => Encode Source Target -> EncodePart Source Target
-  toEncodePart encode (source, target) = [| encode source <+> Just target |]
-
-
 ----------------------
 -- ENCODING TARGETS --
 ----------------------
diff --git a/experiments/idris/src/Fathom/Format/IndexedInductive.idr b/experiments/idris/src/Fathom/Format/IndexedInductive.idr
index d4fd40e59..9e2349d67 100644
--- a/experiments/idris/src/Fathom/Format/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductive.idr
@@ -57,14 +57,10 @@ namespace FormatOf
   decode (Pure x) = pure (MkSing x)
   decode (Ignore f _) = ignore (decode f)
   decode (Repeat 0 f) = pure []
-  decode (Repeat (S len) f) = do
-    x <- decode f
-    xs <- decode (Repeat len f)
-    pure (x :: xs)
-  decode (Pair f1 f2) = do
-    x <- decode f1
-    y <- decode f2
-    pure (x, y)
+  decode (Repeat (S len) f) =
+    [| decode f :: decode (Repeat len f) |]
+  decode (Pair f1 f2) =
+    [| (,) (decode f1) (decode f2) |]
   decode (Bind f1 f2) = do
     x <- decode f1
     y <- decode (f2 x)
diff --git a/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
index 27c1ff0e5..1fc7367f9 100644
--- a/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
@@ -71,14 +71,10 @@ namespace FormatOf
   decode (Pure x) = pure (MkSing x)
   decode (Ignore f _) = ignore (decode f)
   decode (Repeat 0 f) = pure []
-  decode (Repeat (S len) f) = do
-    x <- decode f
-    xs <- decode (Repeat len f)
-    pure (x :: xs)
-  decode (Pair f1 f2) = do
-    x <- decode f1
-    y <- decode f2
-    pure (x, y)
+  decode (Repeat (S len) f) =
+    [| decode f :: decode (Repeat len f) |]
+  decode (Pair f1 f2) =
+    [| (,) (decode f1) (decode f2) |]
   decode (Bind f1 f2) = do
     x <- decode f1
     y <- decode (f2 x)
diff --git a/experiments/idris/src/Fathom/Format/InductiveRecursive.idr b/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
index b3c937e96..6c7975dc4 100644
--- a/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
@@ -94,14 +94,10 @@ namespace Format
   decode (Pure x) = pure (MkSing x)
   decode (Ignore f _) = ignore (decode f)
   decode (Repeat 0 f) = pure []
-  decode (Repeat (S len) f) = do
-    x <- decode f
-    xs <- decode (Repeat len f)
-    pure (x :: xs)
-  decode (Pair f1 f2) = do
-    x <- decode f1
-    y <- decode f2
-    pure (x, y)
+  decode (Repeat (S len) f) =
+    [| decode f :: decode (Repeat len f) |]
+  decode (Pair f1 f2) =
+    [| (,) (decode f1) (decode f2) |]
   decode (Bind f1 f2) = do
     x <- decode f1
     y <- decode (f2 x)
diff --git a/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
index 357476348..7d12f330c 100644
--- a/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
@@ -92,14 +92,10 @@ namespace Format
   decode (Pure x) = pure (MkSing x)
   decode (Ignore f _) = ignore (decode f)
   decode (Repeat 0 f) = pure []
-  decode (Repeat (S len) f) = do
-    x <- decode f
-    xs <- decode (Repeat len f)
-    pure (x :: xs)
-  decode (Pair f1 f2) = do
-    x <- decode f1
-    y <- decode f2
-    pure (x, y)
+  decode (Repeat (S len) f) =
+    [| decode f :: decode (Repeat len f) |]
+  decode (Pair f1 f2) =
+    [| (,) (decode f1) (decode f2) |]
   decode (Bind f1 f2) = do
     x <- decode f1
     y <- decode (f2 x)
diff --git a/experiments/idris/src/Fathom/Format/Record.idr b/experiments/idris/src/Fathom/Format/Record.idr
index 20426a116..5a3c986af 100644
--- a/experiments/idris/src/Fathom/Format/Record.idr
+++ b/experiments/idris/src/Fathom/Format/Record.idr
@@ -98,17 +98,13 @@ namespace Format
     decode = go len where
       go : (len : Nat) -> DecodePart (Vect len f.Rep) ByteStream
       go 0 = pure []
-      go (S len) = do
-        x <- f.decode
-        xs <- go len
-        pure (x :: xs)
+      go (S len) = [| f.decode :: go len |]
 
     encode : Encode Rep ByteStream
     encode = go len where
       go : (len : Nat) -> Encode (Vect len f.Rep) ByteStream
       go 0 [] = pure []
-      go (S len) (x :: xs) =
-        [| f.encode x <+> go len xs |]
+      go (S len) (x :: xs) = [| f.encode x <+> go len xs |]
 
 
   public export
@@ -118,10 +114,8 @@ namespace Format
     Rep = (f1.Rep, f2.Rep)
 
     decode : DecodePart Rep ByteStream
-    decode = do
-      x <- f1.decode
-      y <- f2.decode
-      pure (x, y)
+    decode =
+      [| (,) f1.decode f2.decode |]
 
     encode : Encode Rep ByteStream
     encode (x, y) =

From a082638af21bfe7962d207bb0abce4c3d0fc86f0 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Mon, 12 Sep 2022 15:02:34 +1000
Subject: [PATCH 41/47] Add u32 formats

---
 .../Fathom/Format/IndexedInductiveCustom.idr  | 84 +++++++++++--------
 .../Format/InductiveRecursiveCustom.idr       | 18 ++++
 .../idris/src/Fathom/Format/Record.idr        | 18 ++++
 3 files changed, 84 insertions(+), 36 deletions(-)

diff --git a/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
index 1fc7367f9..717d11ce0 100644
--- a/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
@@ -24,9 +24,8 @@ import Fathom.Data.Sing
 ||| bit temperamental and result in ambiguities when importing modules that
 ||| contain types of the same name as those defined in the current module.
 public export
-record CustomFormat where
-  constructor MkCustomFormat
-  Rep : Type
+record CustomFormatOf (Rep : Type) where
+  constructor MkCustomFormatOf
   decode : Decode (Rep, ByteStream) ByteStream
   encode : Encode Rep ByteStream
 
@@ -41,7 +40,7 @@ data FormatOf : (A : Type) -> Type where
   Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
   Pair : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (A, B)
   Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
-  Custom :  (f : CustomFormat) -> FormatOf f.Rep
+  Custom :  {0 A : Type} -> (f : CustomFormatOf A) -> FormatOf A
 
 
 namespace FormatOf
@@ -97,6 +96,51 @@ namespace FormatOf
   encode (Custom f) x = f.encode x
 
 
+  --------------------
+  -- CUSTOM FORMATS --
+  --------------------
+
+
+  public export
+  u8 : FormatOf Nat
+  u8 = Custom (MkCustomFormatOf
+    { decode = map cast decodeU8
+    , encode = encodeU8 . cast {to = Bits8}
+    })
+
+
+  public export
+  u16Le : FormatOf Nat
+  u16Le = Custom (MkCustomFormatOf
+    { decode = map cast (decodeU16 LE)
+    , encode = encodeU16 LE . cast {to = Bits16}
+    })
+
+
+  public export
+  u16Be : FormatOf Nat
+  u16Be = Custom (MkCustomFormatOf
+    { decode = map cast (decodeU16 BE)
+    , encode = encodeU16 BE . cast {to = Bits16}
+    })
+
+
+  public export
+  u32Le : FormatOf Nat
+  u32Le = Custom (MkCustomFormatOf
+    { decode = map cast (decodeU32 LE)
+    , encode = encodeU32 LE . cast {to = Bits32}
+    })
+
+
+  public export
+  u32Be : FormatOf Nat
+  u32Be = Custom (MkCustomFormatOf
+    { decode = map cast (decodeU32 BE)
+    , encode = encodeU32 BE . cast {to = Bits32}
+    })
+
+
 -------------------------
 -- FORMAT DESCRIPTIONS --
 -------------------------
@@ -224,35 +268,3 @@ namespace Format
   public export
   (>>=) : (f : Format) -> (Rep f -> Format) -> Format
   (>>=) = bind
-
-
---------------------
--- CUSTOM FORMATS --
---------------------
-
-
-public export
-u8 : FormatOf Nat
-u8 = Custom (MkCustomFormat
-  { Rep = Nat
-  , decode = map cast decodeU8
-  , encode = encodeU8 . cast {to = Bits8}
-  })
-
-
-public export
-u16Le : FormatOf Nat
-u16Le = Custom (MkCustomFormat
-  { Rep = Nat
-  , decode = map cast (decodeU16 LE)
-  , encode = encodeU16 LE . cast {to = Bits16}
-  })
-
-
-public export
-u16Be : FormatOf Nat
-u16Be = Custom (MkCustomFormat
-  { Rep = Nat
-  , decode = map cast (decodeU16 BE)
-  , encode = encodeU16 BE . cast {to = Bits16}
-  })
diff --git a/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
index 7d12f330c..93c8e7301 100644
--- a/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
@@ -150,6 +150,24 @@ namespace Format
     })
 
 
+  public export
+  u32Le : Format
+  u32Le = Custom (MkCustomFormat
+    { Rep = Nat
+    , decode = map cast (decodeU32 LE)
+    , encode = encodeU32 LE . cast {to = Bits32}
+    })
+
+
+  public export
+  u32Be : Format
+  u32Be = Custom (MkCustomFormat
+    { Rep = Nat
+    , decode = map cast (decodeU32 BE)
+    , encode = encodeU32 BE . cast {to = Bits32}
+    })
+
+
 ---------------------------------
 -- INDEXED FORMAT DESCRIPTIONS --
 ---------------------------------
diff --git a/experiments/idris/src/Fathom/Format/Record.idr b/experiments/idris/src/Fathom/Format/Record.idr
index 5a3c986af..a1a73879a 100644
--- a/experiments/idris/src/Fathom/Format/Record.idr
+++ b/experiments/idris/src/Fathom/Format/Record.idr
@@ -180,6 +180,24 @@ namespace Format
     }
 
 
+  public export
+  u32Le : Format
+  u32Le = MkFormat
+    { Rep = Nat
+    , decode = map cast (decodeU32 LE)
+    , encode = encodeU32 LE . cast {to = Bits32}
+    }
+
+
+  public export
+  u32Be : Format
+  u32Be = MkFormat
+    { Rep = Nat
+    , decode = map cast (decodeU32 BE)
+    , encode = encodeU32 BE . cast {to = Bits32}
+    }
+
+
 ---------------------------------
 -- INDEXED FORMAT DESCRIPTIONS --
 ---------------------------------

From 1599762d24642271af0d4f5453ec6ed3a2f3cfa1 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Mon, 12 Sep 2022 15:03:19 +1000
Subject: [PATCH 42/47] Play around with heterogeneous sequences

---
 experiments/idris/fathom.ipkg                 |  1 +
 .../src/Playground/HeterogeneousSequences.idr | 43 +++++++++++++++++++
 2 files changed, 44 insertions(+)
 create mode 100644 experiments/idris/src/Playground/HeterogeneousSequences.idr

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index 00b49fc14..b42b13a51 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -27,6 +27,7 @@ modules = Fathom
         , Fathom.Format.Record
 
         , Playground
+        , Playground.HeterogeneousSequences
         , Playground.OpenType.IndexedInductive
         , Playground.OpenType.InductiveRecursive
         , Playground.OpenType.Record
diff --git a/experiments/idris/src/Playground/HeterogeneousSequences.idr b/experiments/idris/src/Playground/HeterogeneousSequences.idr
new file mode 100644
index 000000000..7218e6063
--- /dev/null
+++ b/experiments/idris/src/Playground/HeterogeneousSequences.idr
@@ -0,0 +1,43 @@
+-- Heterogeneous sequence example
+
+module Playground.HeterogeneousSequences
+
+
+import Data.Vect
+
+import Fathom.Data.Sing
+import Fathom.Format.Record
+-- import Fathom.Format.InductiveRecursiveCustom
+
+
+namespace Format
+
+  ||| Construct a format based on a type tag
+  value : Nat -> Format
+  value 1 = u8
+  value 2 = u16Be
+  value 4 = u32Be
+  value _ = fail
+
+
+  ||| A heterogeneous sequence of values where the element formats depend on a
+  ||| sequence of type tags
+  values : (ts : Vect len Nat) -> Format
+  values [] = pure ()
+  values (t :: ts) = pair (value t) (values ts)
+
+
+  ||| An annoying example from: https://github.com/yeslogic/fathom/issues/394
+  ouch : Format
+  ouch = do
+    len <- u16Be
+    types <- repeat len u16Be
+    values <- values types
+    pure ()
+
+
+  ||| Access an element at index @i of the in-memory representation of @values.
+  ||| The type of the returned element is dependent on the sequence of type tags.
+  index : {ts : Vect len Nat} -> (i : Fin len) -> (values ts).Rep -> (value (index i ts)).Rep
+  index {ts = _ :: _} FZ (x, _) = x
+  index {ts = _ :: _} (FS i) (_, xs) = Format.index i xs

From 1c37a1cedce66c0cef0d5b831d428ffb158d8d1e Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Mon, 12 Sep 2022 15:38:15 +1000
Subject: [PATCH 43/47] Create a hetrogeneous repetition format with HVect

---
 experiments/idris/fathom.ipkg                 |  2 +-
 .../idris/src/Fathom/Format/Record.idr        | 20 ++++++++++++++++
 .../src/Playground/HeterogeneousSequences.idr | 24 ++++++++++++++++++-
 3 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index b42b13a51..0a7a10c63 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -10,7 +10,7 @@ package fathom
 -- bugtracker =
 
 -- packages to add to search path
--- depends =
+depends = contrib
 
 -- modules to install
 modules = Fathom
diff --git a/experiments/idris/src/Fathom/Format/Record.idr b/experiments/idris/src/Fathom/Format/Record.idr
index a1a73879a..cea0f89aa 100644
--- a/experiments/idris/src/Fathom/Format/Record.idr
+++ b/experiments/idris/src/Fathom/Format/Record.idr
@@ -13,6 +13,7 @@ module Fathom.Format.Record
 
 import Data.Colist
 import Data.DPair
+import Data.HVect
 import Data.Vect
 
 import Fathom.Base
@@ -107,6 +108,25 @@ namespace Format
       go (S len) (x :: xs) = [| f.encode x <+> go len xs |]
 
 
+  public export
+  hrepeat : {len : Nat} -> Vect len Format -> Format
+  hrepeat fs = MkFormat { Rep, decode, encode } where
+    Rep : Type
+    Rep = HVect (map (.Rep) fs)
+
+    decode : DecodePart Rep ByteStream
+    decode = go fs where
+      go : {len : Nat} -> (fs : Vect len Format) -> DecodePart (HVect (map (.Rep) fs)) ByteStream
+      go {len = Z} [] = pure []
+      go {len = S _} (f :: fs) = [| f.decode :: go fs |]
+
+    encode : Encode Rep ByteStream
+    encode = go fs where
+      go : {len : Nat} -> (fs : Vect len Format) -> Encode (HVect (map (.Rep) fs)) ByteStream
+      go {len = Z} [] [] = pure []
+      go {len = S _} (f :: fs) (x :: xs) = [| f.encode x <+> go fs xs |]
+
+
   public export
   pair : Format -> Format -> Format
   pair f1 f2 = MkFormat { Rep, decode, encode } where
diff --git a/experiments/idris/src/Playground/HeterogeneousSequences.idr b/experiments/idris/src/Playground/HeterogeneousSequences.idr
index 7218e6063..7bc2d25c1 100644
--- a/experiments/idris/src/Playground/HeterogeneousSequences.idr
+++ b/experiments/idris/src/Playground/HeterogeneousSequences.idr
@@ -4,13 +4,15 @@ module Playground.HeterogeneousSequences
 
 
 import Data.Vect
+import Data.HVect
 
+import Fathom.Base
 import Fathom.Data.Sing
 import Fathom.Format.Record
 -- import Fathom.Format.InductiveRecursiveCustom
 
 
-namespace Format
+namespace Format.Pairs
 
   ||| Construct a format based on a type tag
   value : Nat -> Format
@@ -41,3 +43,23 @@ namespace Format
   index : {ts : Vect len Nat} -> (i : Fin len) -> (values ts).Rep -> (value (index i ts)).Rep
   index {ts = _ :: _} FZ (x, _) = x
   index {ts = _ :: _} (FS i) (_, xs) = Format.index i xs
+
+
+namespace Format.HRepeat
+
+  ||| Construct a format based on a type tag
+  value : Nat -> Format
+  value 1 = u8
+  value 2 = u16Be
+  value 4 = u32Be
+  value _ = fail
+
+
+  ||| An annoying example from: https://github.com/yeslogic/fathom/issues/394
+  ouch : Format
+  ouch = do
+    len <- u16Be
+    types <- repeat len u16Be
+    values <- hrepeat (map value types)
+    --        ^^^^^^^ heterogeneous repetitions
+    pure ()

From 9fbf359a44ac5124046d3474de5732b8a94ee9f4 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Mon, 12 Sep 2022 15:57:33 +1000
Subject: [PATCH 44/47] Rename to `hrepeat` to `tuple`

---
 .../idris/src/Fathom/Format/Record.idr        |  4 +-
 .../src/Playground/HeterogeneousSequences.idr | 40 ++-----------------
 2 files changed, 5 insertions(+), 39 deletions(-)

diff --git a/experiments/idris/src/Fathom/Format/Record.idr b/experiments/idris/src/Fathom/Format/Record.idr
index cea0f89aa..a1db450d9 100644
--- a/experiments/idris/src/Fathom/Format/Record.idr
+++ b/experiments/idris/src/Fathom/Format/Record.idr
@@ -109,8 +109,8 @@ namespace Format
 
 
   public export
-  hrepeat : {len : Nat} -> Vect len Format -> Format
-  hrepeat fs = MkFormat { Rep, decode, encode } where
+  tuple : {len : Nat} -> Vect len Format -> Format
+  tuple fs = MkFormat { Rep, decode, encode } where
     Rep : Type
     Rep = HVect (map (.Rep) fs)
 
diff --git a/experiments/idris/src/Playground/HeterogeneousSequences.idr b/experiments/idris/src/Playground/HeterogeneousSequences.idr
index 7bc2d25c1..d0ebdf596 100644
--- a/experiments/idris/src/Playground/HeterogeneousSequences.idr
+++ b/experiments/idris/src/Playground/HeterogeneousSequences.idr
@@ -9,43 +9,9 @@ import Data.HVect
 import Fathom.Base
 import Fathom.Data.Sing
 import Fathom.Format.Record
--- import Fathom.Format.InductiveRecursiveCustom
 
 
-namespace Format.Pairs
-
-  ||| Construct a format based on a type tag
-  value : Nat -> Format
-  value 1 = u8
-  value 2 = u16Be
-  value 4 = u32Be
-  value _ = fail
-
-
-  ||| A heterogeneous sequence of values where the element formats depend on a
-  ||| sequence of type tags
-  values : (ts : Vect len Nat) -> Format
-  values [] = pure ()
-  values (t :: ts) = pair (value t) (values ts)
-
-
-  ||| An annoying example from: https://github.com/yeslogic/fathom/issues/394
-  ouch : Format
-  ouch = do
-    len <- u16Be
-    types <- repeat len u16Be
-    values <- values types
-    pure ()
-
-
-  ||| Access an element at index @i of the in-memory representation of @values.
-  ||| The type of the returned element is dependent on the sequence of type tags.
-  index : {ts : Vect len Nat} -> (i : Fin len) -> (values ts).Rep -> (value (index i ts)).Rep
-  index {ts = _ :: _} FZ (x, _) = x
-  index {ts = _ :: _} (FS i) (_, xs) = Format.index i xs
-
-
-namespace Format.HRepeat
+namespace Format
 
   ||| Construct a format based on a type tag
   value : Nat -> Format
@@ -60,6 +26,6 @@ namespace Format.HRepeat
   ouch = do
     len <- u16Be
     types <- repeat len u16Be
-    values <- hrepeat (map value types)
-    --        ^^^^^^^ heterogeneous repetitions
+    values <- tuple (map value types)
+    --        ^^^^^ heterogeneous sequence of formats
     pure ()

From 348f7fd6d0dd27e3585b292c0acd9c73a47fa1d9 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Mon, 12 Sep 2022 16:22:41 +1000
Subject: [PATCH 45/47] Move compiler experiments

---
 experiments/idris/fathom.ipkg                 |   1 +
 .../idris/src/Playground/Extraction.idr       | 104 ++++++++++++++++++
 .../OpenType/InductiveRecursive.idr           |  97 ----------------
 3 files changed, 105 insertions(+), 97 deletions(-)
 create mode 100644 experiments/idris/src/Playground/Extraction.idr

diff --git a/experiments/idris/fathom.ipkg b/experiments/idris/fathom.ipkg
index 0a7a10c63..dddbe420c 100644
--- a/experiments/idris/fathom.ipkg
+++ b/experiments/idris/fathom.ipkg
@@ -27,6 +27,7 @@ modules = Fathom
         , Fathom.Format.Record
 
         , Playground
+        , Playground.Extraction
         , Playground.HeterogeneousSequences
         , Playground.OpenType.IndexedInductive
         , Playground.OpenType.InductiveRecursive
diff --git a/experiments/idris/src/Playground/Extraction.idr b/experiments/idris/src/Playground/Extraction.idr
new file mode 100644
index 000000000..7640700f1
--- /dev/null
+++ b/experiments/idris/src/Playground/Extraction.idr
@@ -0,0 +1,104 @@
+||| Thinking about extracting format descriptions to Rust
+
+module Playground.Extraction
+
+
+import Fathom.Data.Sing
+import Fathom.Format.InductiveRecursiveCustom
+
+
+namespace Rust
+
+  data RType : Type where
+    Var : String -> RType
+    U8 : RType
+    U16 : RType
+    U32 : RType
+    U64 : RType
+    I8 : RType
+    I16 : RType
+    I32 : RType
+    I64 : RType
+    Never : RType
+    Tuple : List RType -> RType
+    Vec : RType -> RType
+
+
+  data Item : Type where
+    Struct : List (String, RType) -> Item
+    Enum : List (String, RType) -> Item
+    DecodeFn : () -> Item
+    EncodeFn : () -> Item
+
+
+  record Module where
+    constructor MkModule
+    items : List (String, Item)
+
+
+namespace Compile
+
+  -- TODO: Cache compilations of definitions
+  --       eg. of structs, enums, endocers and decoders
+
+
+  compileFormat : Format -> (Rust.Module -> Maybe Rust.Module)
+  compileFormat f =
+    -- compile rep
+    -- compile decode
+    -- compile encode
+    ?todo_compileFormat
+
+
+  compileRep : (f : Format) -> Maybe Rust.RType
+  compileRep End = Just (Rust.Tuple [])
+  compileRep Fail = Just (Rust.Never)
+  compileRep (Ignore _ _) = Just (Rust.Tuple [])
+  compileRep (Repeat _ f) =
+    Just (Rust.Vec !(compileRep f)) -- TODO: Compile to a contract? Or maybe a
+                                    --       fixed size array if the length is known
+                                    --       or just throw away the info
+  compileRep (Pure x) =
+    ?todo_compileSingRep -- TODO: interpret an Idris type as a Rust type??
+                         --       perhaps we need to restrict this?
+  compileRep (Pair f1 f2) =
+    Just (Rust.Tuple
+      [ !(compileRep f1)
+      , !(compileRep f2)
+      ])
+  compileRep (Bind f1 f2) =
+    Just (Tuple
+      [ !(compileRep f1)
+      , !(compileRep (f2 ?todo_compileBind_x))  -- TODO: how to bind the output?
+                                                --       enum based on the values of `x : Rep f1`?
+                                                --       depends on how `x` is used inside `f2`
+      ])
+  compileRep (Custom f) =
+    -- TODO: f.RustRep
+    Nothing
+
+
+  compileDecode : Format -> (Rust.Module -> Maybe Rust.Module)
+  compileDecode End = ?todo_compileDecodeEnd
+  compileDecode Fail = ?todo_compileDecodeFail
+  compileDecode (Pure x) = ?todo_compileDecodePure
+  compileDecode (Ignore f _) = ?todo_compileDecodeIgnore
+  compileDecode (Repeat len f) = ?todo_compileDecodeRepeat
+  compileDecode (Pair f1 f2) = ?todo_compileDecodePair
+  compileDecode (Bind f1 f2) = ?todo_compileDecodeBind
+  compileDecode (Custom f) =
+    -- TODO: f.rustDecode
+    ?todo_compileDecodeCustom
+
+
+  compileEncode : Format -> (Rust.Module -> Maybe Rust.Module)
+  compileEncode End = ?todo_compileEncodeEnd
+  compileEncode Fail = ?todo_compileEncodeFail
+  compileEncode (Pure x) = ?todo_compileEncodePure
+  compileEncode (Ignore f def) = ?todo_compileEncodeIgnore
+  compileEncode (Repeat len f) = ?todo_compileEncodeRepeat
+  compileEncode (Pair f1 f2) = ?todo_compileEncodePair
+  compileEncode (Bind f1 f2) = ?todo_compileEncodeBind
+  compileEncode (Custom f) =
+    -- TODO: f.rustEncode
+    ?todo_compileEncodeCustom
diff --git a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
index bfa65c392..01ae5f459 100644
--- a/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
+++ b/experiments/idris/src/Playground/OpenType/InductiveRecursive.idr
@@ -90,100 +90,3 @@ namespace FormatOf
   simple_glyph = FormatOf.do
     flag <- flag
     pure (flag.repeat + 1)
-
-
--- Thinking about compilation
-
-namespace Rust
-
-  data RType : Type where
-    Var : String -> RType
-    U8 : RType
-    U16 : RType
-    U32 : RType
-    U64 : RType
-    I8 : RType
-    I16 : RType
-    I32 : RType
-    I64 : RType
-    Never : RType
-    Tuple : List RType -> RType
-    Vec : RType -> RType
-
-  data Item : Type where
-    Struct : List (String, RType) -> Item
-    Enum : List (String, RType) -> Item
-    DecodeFn : () -> Item
-    EncodeFn : () -> Item
-
-  record Module where
-    constructor MkModule
-    items : List (String, Item)
-
-
-namespace Compile
-
-  -- TODO: Cache compilations of definitions
-  --       eg. of structs, enums, endocers and decoders
-
-
-  compileFormat : Format -> (Rust.Module -> Maybe Rust.Module)
-  compileFormat f =
-    -- compile rep
-    -- compile decode
-    -- compile encode
-    ?todo_compileFormat
-
-
-  compileRep : (f : Format) -> Maybe Rust.RType
-  compileRep End = Just (Rust.Tuple [])
-  compileRep Fail = Just (Rust.Never)
-  compileRep (Ignore _ _) = Just (Rust.Tuple [])
-  compileRep (Repeat _ f) =
-    Just (Rust.Vec !(compileRep f)) -- TODO: Compile to a contract? Or maybe a
-                                    --       fixed size array if the length is known
-                                    --       or just throw away the info
-  compileRep (Pure x) =
-    ?todo_compileSingRep -- TODO: interpret an Idris type as a Rust type??
-                         --       perhaps we need to restrict this?
-  compileRep (Pair f1 f2) =
-    Just (Rust.Tuple
-      [ !(compileRep f1)
-      , !(compileRep f2)
-      ])
-  compileRep (Bind f1 f2) =
-    Just (Tuple
-      [ !(compileRep f1)
-      , !(compileRep (f2 ?todo_compileBind_x))  -- TODO: how to bind the output?
-                                                --       enum based on the values of `x : Rep f1`?
-                                                --       depends on how `x` is used inside `f2`
-      ])
-  compileRep (Custom f) =
-    -- TODO: f.RustRep
-    Nothing
-
-
-  compileDecode : Format -> (Rust.Module -> Maybe Rust.Module)
-  compileDecode End = ?todo_compileDecodeEnd
-  compileDecode Fail = ?todo_compileDecodeFail
-  compileDecode (Pure x) = ?todo_compileDecodePure
-  compileDecode (Ignore f _) = ?todo_compileDecodeIgnore
-  compileDecode (Repeat len f) = ?todo_compileDecodeRepeat
-  compileDecode (Pair f1 f2) = ?todo_compileDecodePair
-  compileDecode (Bind f1 f2) = ?todo_compileDecodeBind
-  compileDecode (Custom f) =
-    -- TODO: f.rustDecode
-    ?todo_compileDecodeCustom
-
-
-  compileEncode : Format -> (Rust.Module -> Maybe Rust.Module)
-  compileEncode End = ?todo_compileEncodeEnd
-  compileEncode Fail = ?todo_compileEncodeFail
-  compileEncode (Pure x) = ?todo_compileEncodePure
-  compileEncode (Ignore f def) = ?todo_compileEncodeIgnore
-  compileEncode (Repeat len f) = ?todo_compileEncodeRepeat
-  compileEncode (Pair f1 f2) = ?todo_compileEncodePair
-  compileEncode (Bind f1 f2) = ?todo_compileEncodeBind
-  compileEncode (Custom f) =
-    -- TODO: f.rustEncode
-    ?todo_compileEncodeCustom

From 1cc160201bb28d9fc07744c19672c09c1cfd7c62 Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Mon, 12 Sep 2022 17:27:37 +1000
Subject: [PATCH 46/47] Implement tuple in other format decription styles

---
 .../idris/src/Fathom/Format/IndexedInductive.idr   | 12 ++++++++++++
 .../src/Fathom/Format/IndexedInductiveCustom.idr   | 12 ++++++++++++
 .../idris/src/Fathom/Format/InductiveRecursive.idr | 11 ++++++++++-
 .../src/Fathom/Format/InductiveRecursiveCustom.idr | 11 ++++++++++-
 experiments/idris/src/Fathom/Format/Record.idr     | 14 +++++++-------
 experiments/idris/src/Playground.idr               |  6 ++++++
 experiments/idris/src/Playground/Extraction.idr    |  4 ++++
 7 files changed, 61 insertions(+), 9 deletions(-)

diff --git a/experiments/idris/src/Fathom/Format/IndexedInductive.idr b/experiments/idris/src/Fathom/Format/IndexedInductive.idr
index 9e2349d67..92d1c2eaa 100644
--- a/experiments/idris/src/Fathom/Format/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductive.idr
@@ -6,6 +6,7 @@ module Fathom.Format.IndexedInductive
 
 import Data.Colist
 import Data.DPair
+import Data.HVect
 import Data.Vect
 
 import Fathom.Base
@@ -26,6 +27,7 @@ data FormatOf : Type -> Type where
   Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
   Ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
   Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
+  Tuple : {reps : Vect len Type} -> HVect (map FormatOf reps) -> FormatOf (HVect reps)
   Pair : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (A, B)
   Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
 
@@ -59,6 +61,13 @@ namespace FormatOf
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) =
     [| decode f :: decode (Repeat len f) |]
+  decode (Tuple {reps = []} []) = pure []
+  decode (Tuple {reps = _::_} (f :: fs)) = DecodePart.do
+    x <- decode f
+    xs <- decode (Tuple fs)
+    pure (x :: xs)
+    -- FIXME: Ambiguous elaboration for some reason??
+    -- [| decode f :: decode (Tuple fs) |]
   decode (Pair f1 f2) =
     [| (,) (decode f1) (decode f2) |]
   decode (Bind f1 f2) = do
@@ -75,6 +84,9 @@ namespace FormatOf
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Tuple {reps = []} []) [] = pure []
+  encode (Tuple {reps = _::_} (f :: fs)) (x :: xs) =
+    [| encode f x <+> encode (Tuple fs) xs |]
   encode (Pair f1 f2) (x, y) =
     [| encode f1 x <+> encode f2 y |]
   encode (Bind f1 f2) (x ** y) =
diff --git a/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
index 717d11ce0..895db3853 100644
--- a/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
@@ -6,6 +6,7 @@ module Fathom.Format.IndexedInductiveCustom
 
 import Data.Colist
 import Data.DPair
+import Data.HVect
 import Data.Vect
 
 import Fathom.Base
@@ -38,6 +39,7 @@ data FormatOf : (A : Type) -> Type where
   Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
   Ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
   Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
+  Tuple : {reps : Vect len Type} -> HVect (map FormatOf reps) -> FormatOf (HVect reps)
   Pair : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (A, B)
   Bind : {0 A : Type} -> {0 B : A -> Type} -> (f : FormatOf A) -> ((x : A) -> FormatOf (B x)) -> FormatOf (x : A ** B x)
   Custom :  {0 A : Type} -> (f : CustomFormatOf A) -> FormatOf A
@@ -72,6 +74,13 @@ namespace FormatOf
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) =
     [| decode f :: decode (Repeat len f) |]
+  decode (Tuple {reps = []} []) = pure []
+  decode (Tuple {reps = _::_} (f :: fs)) = DecodePart.do
+    x <- decode f
+    xs <- decode (Tuple fs)
+    pure (x :: xs)
+    -- FIXME: Ambiguous elaboration for some reason??
+    -- [| decode f :: decode (Tuple fs) |]
   decode (Pair f1 f2) =
     [| (,) (decode f1) (decode f2) |]
   decode (Bind f1 f2) = do
@@ -89,6 +98,9 @@ namespace FormatOf
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Tuple {reps = []} []) [] = pure []
+  encode (Tuple {reps = _::_} (f :: fs)) (x :: xs) =
+    [| encode f x <+> encode (Tuple fs) xs |]
   encode (Pair f1 f2) (x, y) =
     [| encode f1 x <+> encode f2 y |]
   encode (Bind f1 f2) (x ** y) =
diff --git a/experiments/idris/src/Fathom/Format/InductiveRecursive.idr b/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
index 6c7975dc4..b2c6458ff 100644
--- a/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
@@ -24,6 +24,7 @@ module Fathom.Format.InductiveRecursive
 
 import Data.Colist
 import Data.DPair
+import Data.HVect
 import Data.Vect
 
 import Fathom.Base
@@ -45,6 +46,7 @@ mutual
     Pure : {0 A : Type} -> A -> Format
     Ignore : (f : Format) -> (def : f.Rep) -> Format
     Repeat : Nat -> Format -> Format
+    Tuple : {0 len : Nat} -> Vect len Format -> Format
     Pair : Format -> Format -> Format
     Bind : (f : Format) -> (f.Rep -> Format) -> Format
 
@@ -54,9 +56,10 @@ mutual
   Rep : Format -> Type
   Rep End = Unit
   Rep Fail = Void
+  Rep (Pure x) = Sing x
   Rep (Ignore _ _) = Unit
   Rep (Repeat len f) = Vect len f.Rep
-  Rep (Pure x) = Sing x
+  Rep (Tuple fs) = HVect (map (.Rep) fs)
   Rep (Pair f1 f2) = (f1.Rep, f2.Rep)
   Rep (Bind f1 f2) = (x : f1.Rep ** (f2 x).Rep)
 
@@ -96,6 +99,9 @@ namespace Format
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) =
     [| decode f :: decode (Repeat len f) |]
+  decode (Tuple []) = pure []
+  decode (Tuple (f :: fs)) =
+    [| decode f :: decode (Tuple fs) |]
   decode (Pair f1 f2) =
     [| (,) (decode f1) (decode f2) |]
   decode (Bind f1 f2) = do
@@ -112,6 +118,9 @@ namespace Format
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Tuple []) [] = pure []
+  encode (Tuple (f :: fs)) (x :: xs) =
+    [| encode f x <+> encode (Tuple fs) xs |]
   encode (Pair f1 f2) (x, y) =
     [| encode f1 x <+> encode f2 y |]
   encode (Bind f1 f2) (x ** y) =
diff --git a/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
index 93c8e7301..3a624640e 100644
--- a/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
@@ -7,6 +7,7 @@ module Fathom.Format.InductiveRecursiveCustom
 import Data.Bits
 import Data.Colist
 import Data.DPair
+import Data.HVect
 import Data.Vect
 
 import Fathom.Base
@@ -41,6 +42,7 @@ mutual
     Pure : {0 A : Type} -> A -> Format
     Ignore : (f : Format) -> (def : f.Rep) -> Format
     Repeat : Nat -> Format -> Format
+    Tuple : {0 len : Nat} -> Vect len Format -> Format
     Pair : Format -> Format -> Format
     Bind : (f : Format) -> (f.Rep -> Format) -> Format
     Custom :  (f : CustomFormat) -> Format
@@ -51,9 +53,10 @@ mutual
   Rep : Format -> Type
   Rep End = Unit
   Rep Fail = Void
+  Rep (Pure x) = Sing x
   Rep (Ignore _ _) = Unit
   Rep (Repeat len f) = Vect len f.Rep
-  Rep (Pure x) = Sing x
+  Rep (Tuple fs) = HVect (map (.Rep) fs)
   Rep (Pair f1 f2) = (f1.Rep, f2.Rep)
   Rep (Bind f1 f2) = (x : f1.Rep ** (f2 x).Rep)
   Rep (Custom f) = f.Rep
@@ -94,6 +97,9 @@ namespace Format
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) =
     [| decode f :: decode (Repeat len f) |]
+  decode (Tuple []) = pure []
+  decode (Tuple (f :: fs)) =
+    [| decode f :: decode (Tuple fs) |]
   decode (Pair f1 f2) =
     [| (,) (decode f1) (decode f2) |]
   decode (Bind f1 f2) = do
@@ -111,6 +117,9 @@ namespace Format
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
+  encode (Tuple []) [] = pure []
+  encode (Tuple (f :: fs)) (x :: xs) =
+    [| encode f x <+> encode (Tuple fs) xs |]
   encode (Pair f1 f2) (x, y) =
     [| encode f1 x <+> encode f2 y |]
   encode (Bind f1 f2) (x ** y) =
diff --git a/experiments/idris/src/Fathom/Format/Record.idr b/experiments/idris/src/Fathom/Format/Record.idr
index a1db450d9..34f7d00bb 100644
--- a/experiments/idris/src/Fathom/Format/Record.idr
+++ b/experiments/idris/src/Fathom/Format/Record.idr
@@ -109,22 +109,22 @@ namespace Format
 
 
   public export
-  tuple : {len : Nat} -> Vect len Format -> Format
+  tuple : {0 len : Nat} -> Vect len Format -> Format
   tuple fs = MkFormat { Rep, decode, encode } where
     Rep : Type
     Rep = HVect (map (.Rep) fs)
 
     decode : DecodePart Rep ByteStream
     decode = go fs where
-      go : {len : Nat} -> (fs : Vect len Format) -> DecodePart (HVect (map (.Rep) fs)) ByteStream
-      go {len = Z} [] = pure []
-      go {len = S _} (f :: fs) = [| f.decode :: go fs |]
+      go : {0 len : Nat} -> (fs : Vect len Format) -> DecodePart (HVect (map (.Rep) fs)) ByteStream
+      go [] = pure []
+      go (f :: fs) = [| f.decode :: go fs |]
 
     encode : Encode Rep ByteStream
     encode = go fs where
-      go : {len : Nat} -> (fs : Vect len Format) -> Encode (HVect (map (.Rep) fs)) ByteStream
-      go {len = Z} [] [] = pure []
-      go {len = S _} (f :: fs) (x :: xs) = [| f.encode x <+> go fs xs |]
+      go : {0 len : Nat} -> (fs : Vect len Format) -> Encode (HVect (map (.Rep) fs)) ByteStream
+      go [] [] = pure []
+      go (f :: fs) (x :: xs) = [| f.encode x <+> go fs xs |]
 
 
   public export
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index 9dc1983a4..53f086502 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -3,6 +3,7 @@ module Playground
 
 import Data.Colist
 import Data.Vect
+import Data.HVect
 
 import Fathom.Base
 import Fathom.Data.Sing
@@ -70,6 +71,7 @@ indRecToIndexed Fail = Indexed.Fail
 indRecToIndexed (Pure x) = Indexed.Pure x
 indRecToIndexed (Ignore f def) = Indexed.Ignore (indRecToIndexed f) def
 indRecToIndexed (Repeat len f) = Indexed.Repeat len (indRecToIndexed f)
+indRecToIndexed (Tuple fs) = ?todo_indRecToIndexedTuple
 indRecToIndexed (Pair f1 f2) = Indexed.Pair (indRecToIndexed f1) (indRecToIndexed f2)
 indRecToIndexed (Bind f g) = Indexed.Bind (indRecToIndexed f) (\x => indRecToIndexed (g x))
 
@@ -85,6 +87,8 @@ mutual
     _ | MkFormatOf f' = (Ignore f' def ** Refl)
   indexedToIndRecFormat (MkFormat (Vect len _) (Repeat len f)) with (indexedToIndRecFormatOf f)
     _ | MkFormatOf f' = (Repeat len f' ** Refl)
+  indexedToIndRecFormat (MkFormat (HVect reps) (Tuple fs)) =
+    ?todo_indexedToIndRecFormatTuple
   indexedToIndRecFormat (MkFormat (_, _) (Pair f1 f2)) with (indexedToIndRecFormatOf f1, indexedToIndRecFormatOf f2)
     _ | (MkFormatOf f1', MkFormatOf f2') = (Pair f1' f2' ** Refl)
   indexedToIndRecFormat (MkFormat (x : _ ** _) (Bind f1 f2)) with (indexedToIndRecFormatOf f1)
@@ -101,6 +105,8 @@ mutual
     _ | MkFormatOf f' = MkFormatOf (Ignore f' def)
   indexedToIndRecFormatOf (Repeat len f) with (indexedToIndRecFormatOf f)
     _ | MkFormatOf f' = MkFormatOf (Repeat len f')
+  indexedToIndRecFormatOf (Tuple fs) =
+    ?todo_indexedToIndRecFormatOfTuple
   indexedToIndRecFormatOf (Pair f1 f2) with (indexedToIndRecFormatOf f1, indexedToIndRecFormatOf f2)
     _ | (MkFormatOf f1', MkFormatOf f2') = MkFormatOf (Pair f1' f2')
   indexedToIndRecFormatOf (Bind f1 f2) with (indexedToIndRecFormatOf f1)
diff --git a/experiments/idris/src/Playground/Extraction.idr b/experiments/idris/src/Playground/Extraction.idr
index 7640700f1..6e3fd79fc 100644
--- a/experiments/idris/src/Playground/Extraction.idr
+++ b/experiments/idris/src/Playground/Extraction.idr
@@ -58,6 +58,8 @@ namespace Compile
     Just (Rust.Vec !(compileRep f)) -- TODO: Compile to a contract? Or maybe a
                                     --       fixed size array if the length is known
                                     --       or just throw away the info
+  compileRep (Tuple fs) =
+    ?todo_compileRepTuple
   compileRep (Pure x) =
     ?todo_compileSingRep -- TODO: interpret an Idris type as a Rust type??
                          --       perhaps we need to restrict this?
@@ -84,6 +86,7 @@ namespace Compile
   compileDecode (Pure x) = ?todo_compileDecodePure
   compileDecode (Ignore f _) = ?todo_compileDecodeIgnore
   compileDecode (Repeat len f) = ?todo_compileDecodeRepeat
+  compileDecode (Tuple fs) = ?todo_compileDecodeTuple
   compileDecode (Pair f1 f2) = ?todo_compileDecodePair
   compileDecode (Bind f1 f2) = ?todo_compileDecodeBind
   compileDecode (Custom f) =
@@ -97,6 +100,7 @@ namespace Compile
   compileEncode (Pure x) = ?todo_compileEncodePure
   compileEncode (Ignore f def) = ?todo_compileEncodeIgnore
   compileEncode (Repeat len f) = ?todo_compileEncodeRepeat
+  compileEncode (Tuple fs) = ?todo_compileEncodeTuple
   compileEncode (Pair f1 f2) = ?todo_compileEncodePair
   compileEncode (Bind f1 f2) = ?todo_compileEncodeBind
   compileEncode (Custom f) =

From bac57891602c03fadb81a1ddc8755d02da58bf6f Mon Sep 17 00:00:00 2001
From: brendanzab <bjzaba@yahoo.com.au>
Date: Tue, 13 Sep 2022 11:10:51 +1000
Subject: [PATCH 47/47] Choice formats

---
 experiments/idris/src/Fathom/Base.idr             |  6 ++++++
 .../idris/src/Fathom/Format/IndexedInductive.idr  |  5 +++++
 .../src/Fathom/Format/IndexedInductiveCustom.idr  |  5 +++++
 .../src/Fathom/Format/InductiveRecursive.idr      |  6 ++++++
 .../Fathom/Format/InductiveRecursiveCustom.idr    |  6 ++++++
 experiments/idris/src/Fathom/Format/Record.idr    | 15 +++++++++++++++
 experiments/idris/src/Playground.idr              |  5 +++++
 experiments/idris/src/Playground/Extraction.idr   |  4 ++++
 8 files changed, 52 insertions(+)

diff --git a/experiments/idris/src/Fathom/Base.idr b/experiments/idris/src/Fathom/Base.idr
index a98ce37b5..298246392 100644
--- a/experiments/idris/src/Fathom/Base.idr
+++ b/experiments/idris/src/Fathom/Base.idr
@@ -133,6 +133,12 @@ namespace DecodePart
   (>>=) = bind
 
 
+  public export
+  (<|>) : {0 S, T : Type} -> DecodePart S T -> Lazy (DecodePart S T) -> DecodePart S T
+  (<|>) decode1 decode2 target =
+    Prelude.(<|>) (decode1 target) (decode2 target)
+
+
 ----------------------
 -- ENCODING TARGETS --
 ----------------------
diff --git a/experiments/idris/src/Fathom/Format/IndexedInductive.idr b/experiments/idris/src/Fathom/Format/IndexedInductive.idr
index 92d1c2eaa..f20dc19ac 100644
--- a/experiments/idris/src/Fathom/Format/IndexedInductive.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductive.idr
@@ -26,6 +26,7 @@ data FormatOf : Type -> Type where
   Fail : FormatOf Void
   Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
   Ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  Choice : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (Either A B)
   Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
   Tuple : {reps : Vect len Type} -> HVect (map FormatOf reps) -> FormatOf (HVect reps)
   Pair : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (A, B)
@@ -58,6 +59,8 @@ namespace FormatOf
   decode Fail = const Nothing
   decode (Pure x) = pure (MkSing x)
   decode (Ignore f _) = ignore (decode f)
+  decode (Choice f1 f2) =
+    [| Left (decode f1) |] <|> [| Right (decode f2) |]
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) =
     [| decode f :: decode (Repeat len f) |]
@@ -81,6 +84,8 @@ namespace FormatOf
   encode End () = pure []
   encode (Pure x) (MkSing _) = pure []
   encode (Ignore f def) () = encode f def
+  encode (Choice f1 f2) (Left x) = encode f1 x
+  encode (Choice f1 f2) (Right y) = encode f2 y
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
diff --git a/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
index 895db3853..72c035bb3 100644
--- a/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/IndexedInductiveCustom.idr
@@ -38,6 +38,7 @@ data FormatOf : (A : Type) -> Type where
   Fail : FormatOf Void
   Pure : {0 A : Type} -> (x : A) -> FormatOf (Sing x)
   Ignore : {0 A : Type} -> (f : FormatOf A) -> (def : A) -> FormatOf Unit
+  Choice : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (Either A B)
   Repeat : {0 A : Type} -> (len : Nat) -> FormatOf A -> FormatOf (Vect len A)
   Tuple : {reps : Vect len Type} -> HVect (map FormatOf reps) -> FormatOf (HVect reps)
   Pair : {0 A, B : Type} -> FormatOf A -> FormatOf B -> FormatOf (A, B)
@@ -71,6 +72,8 @@ namespace FormatOf
   decode Fail = const Nothing
   decode (Pure x) = pure (MkSing x)
   decode (Ignore f _) = ignore (decode f)
+  decode (Choice f1 f2) =
+    [| Left (decode f1) |] <|> [| Right (decode f2) |]
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) =
     [| decode f :: decode (Repeat len f) |]
@@ -95,6 +98,8 @@ namespace FormatOf
   encode End () = pure []
   encode (Pure x) (MkSing _) = pure []
   encode (Ignore f def) () = encode f def
+  encode (Choice f1 f2) (Left x) = encode f1 x
+  encode (Choice f1 f2) (Right y) = encode f2 y
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
diff --git a/experiments/idris/src/Fathom/Format/InductiveRecursive.idr b/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
index b2c6458ff..336fb8d71 100644
--- a/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursive.idr
@@ -45,6 +45,7 @@ mutual
     Fail : Format
     Pure : {0 A : Type} -> A -> Format
     Ignore : (f : Format) -> (def : f.Rep) -> Format
+    Choice : Format -> Format -> Format
     Repeat : Nat -> Format -> Format
     Tuple : {0 len : Nat} -> Vect len Format -> Format
     Pair : Format -> Format -> Format
@@ -58,6 +59,7 @@ mutual
   Rep Fail = Void
   Rep (Pure x) = Sing x
   Rep (Ignore _ _) = Unit
+  Rep (Choice f1 f2) = Either f1.Rep f2.Rep
   Rep (Repeat len f) = Vect len f.Rep
   Rep (Tuple fs) = HVect (map (.Rep) fs)
   Rep (Pair f1 f2) = (f1.Rep, f2.Rep)
@@ -96,6 +98,8 @@ namespace Format
   decode Fail = const Nothing
   decode (Pure x) = pure (MkSing x)
   decode (Ignore f _) = ignore (decode f)
+  decode (Choice f1 f2) =
+    [| Left (decode f1) |] <|> [| Right (decode f2) |]
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) =
     [| decode f :: decode (Repeat len f) |]
@@ -115,6 +119,8 @@ namespace Format
   encode End () = pure []
   encode (Pure x) (MkSing _) = pure []
   encode (Ignore f def) () = encode f def
+  encode (Choice f1 f2) (Left x) = encode f1 x
+  encode (Choice f1 f2) (Right y) = encode f2 y
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
diff --git a/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
index 3a624640e..ec24f85f6 100644
--- a/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
+++ b/experiments/idris/src/Fathom/Format/InductiveRecursiveCustom.idr
@@ -41,6 +41,7 @@ mutual
     Fail : Format
     Pure : {0 A : Type} -> A -> Format
     Ignore : (f : Format) -> (def : f.Rep) -> Format
+    Choice : Format -> Format -> Format
     Repeat : Nat -> Format -> Format
     Tuple : {0 len : Nat} -> Vect len Format -> Format
     Pair : Format -> Format -> Format
@@ -55,6 +56,7 @@ mutual
   Rep Fail = Void
   Rep (Pure x) = Sing x
   Rep (Ignore _ _) = Unit
+  Rep (Choice f1 f2) = Either f1.Rep f2.Rep
   Rep (Repeat len f) = Vect len f.Rep
   Rep (Tuple fs) = HVect (map (.Rep) fs)
   Rep (Pair f1 f2) = (f1.Rep, f2.Rep)
@@ -94,6 +96,8 @@ namespace Format
   decode Fail = const Nothing
   decode (Pure x) = pure (MkSing x)
   decode (Ignore f _) = ignore (decode f)
+  decode (Choice f1 f2) =
+    [| Left (decode f1) |] <|> [| Right (decode f2) |]
   decode (Repeat 0 f) = pure []
   decode (Repeat (S len) f) =
     [| decode f :: decode (Repeat len f) |]
@@ -114,6 +118,8 @@ namespace Format
   encode End () = pure []
   encode (Pure x) (MkSing _) = pure []
   encode (Ignore f def) () = encode f def
+  encode (Choice f1 f2) (Left x) = encode f1 x
+  encode (Choice f1 f2) (Right y) = encode f2 y
   encode (Repeat Z f) [] = pure []
   encode (Repeat (S len) f) (x :: xs) =
     [| encode f x <+> encode (Repeat len f) xs |]
diff --git a/experiments/idris/src/Fathom/Format/Record.idr b/experiments/idris/src/Fathom/Format/Record.idr
index 34f7d00bb..8e033a116 100644
--- a/experiments/idris/src/Fathom/Format/Record.idr
+++ b/experiments/idris/src/Fathom/Format/Record.idr
@@ -89,6 +89,21 @@ namespace Format
     encode () = f.encode def
 
 
+  public export
+  choice : Format -> Format -> Format
+  choice f1 f2 = MkFormat { Rep, decode, encode } where
+    Rep : Type
+    Rep = Either f1.Rep f2.Rep
+
+    decode : DecodePart Rep ByteStream
+    decode =
+      [| Left f1.decode |] <|> [| Right f2.decode |]
+
+    encode : Encode Rep ByteStream
+    encode (Left x) = f1.encode x
+    encode (Right y) = f2.encode y
+
+
   public export
   repeat : Nat -> Format -> Format
   repeat len f = MkFormat { Rep, decode, encode } where
diff --git a/experiments/idris/src/Playground.idr b/experiments/idris/src/Playground.idr
index 53f086502..6f56d8a4f 100644
--- a/experiments/idris/src/Playground.idr
+++ b/experiments/idris/src/Playground.idr
@@ -70,6 +70,7 @@ indRecToIndexed End = Indexed.End
 indRecToIndexed Fail = Indexed.Fail
 indRecToIndexed (Pure x) = Indexed.Pure x
 indRecToIndexed (Ignore f def) = Indexed.Ignore (indRecToIndexed f) def
+indRecToIndexed (Choice f1 f2) = Indexed.Choice (indRecToIndexed f1) (indRecToIndexed f2)
 indRecToIndexed (Repeat len f) = Indexed.Repeat len (indRecToIndexed f)
 indRecToIndexed (Tuple fs) = ?todo_indRecToIndexedTuple
 indRecToIndexed (Pair f1 f2) = Indexed.Pair (indRecToIndexed f1) (indRecToIndexed f2)
@@ -85,6 +86,8 @@ mutual
   indexedToIndRecFormat (MkFormat (Sing x) (Pure x)) = (Pure x ** Refl)
   indexedToIndRecFormat (MkFormat () (Ignore f def)) with (indexedToIndRecFormatOf f)
     _ | MkFormatOf f' = (Ignore f' def ** Refl)
+  indexedToIndRecFormat (MkFormat (Either _ _) (Choice f1 f2)) with (indexedToIndRecFormatOf f1, indexedToIndRecFormatOf f2)
+    _ | (MkFormatOf f1', MkFormatOf f2') = (Choice f1' f2' ** Refl)
   indexedToIndRecFormat (MkFormat (Vect len _) (Repeat len f)) with (indexedToIndRecFormatOf f)
     _ | MkFormatOf f' = (Repeat len f' ** Refl)
   indexedToIndRecFormat (MkFormat (HVect reps) (Tuple fs)) =
@@ -103,6 +106,8 @@ mutual
   indexedToIndRecFormatOf (Pure x) = MkFormatOf (Pure x)
   indexedToIndRecFormatOf (Ignore f def) with (indexedToIndRecFormatOf f)
     _ | MkFormatOf f' = MkFormatOf (Ignore f' def)
+  indexedToIndRecFormatOf (Choice f1 f2) with (indexedToIndRecFormatOf f1, indexedToIndRecFormatOf f2)
+    _ | (MkFormatOf f1', MkFormatOf f2') = MkFormatOf (Choice f1' f2')
   indexedToIndRecFormatOf (Repeat len f) with (indexedToIndRecFormatOf f)
     _ | MkFormatOf f' = MkFormatOf (Repeat len f')
   indexedToIndRecFormatOf (Tuple fs) =
diff --git a/experiments/idris/src/Playground/Extraction.idr b/experiments/idris/src/Playground/Extraction.idr
index 6e3fd79fc..75e0c99e0 100644
--- a/experiments/idris/src/Playground/Extraction.idr
+++ b/experiments/idris/src/Playground/Extraction.idr
@@ -54,6 +54,8 @@ namespace Compile
   compileRep End = Just (Rust.Tuple [])
   compileRep Fail = Just (Rust.Never)
   compileRep (Ignore _ _) = Just (Rust.Tuple [])
+  compileRep (Choice f1 f2) =
+    ?todo_compileRepChoice
   compileRep (Repeat _ f) =
     Just (Rust.Vec !(compileRep f)) -- TODO: Compile to a contract? Or maybe a
                                     --       fixed size array if the length is known
@@ -85,6 +87,7 @@ namespace Compile
   compileDecode Fail = ?todo_compileDecodeFail
   compileDecode (Pure x) = ?todo_compileDecodePure
   compileDecode (Ignore f _) = ?todo_compileDecodeIgnore
+  compileDecode (Choice f1 f2) = ?todo_compileDecodeChoice
   compileDecode (Repeat len f) = ?todo_compileDecodeRepeat
   compileDecode (Tuple fs) = ?todo_compileDecodeTuple
   compileDecode (Pair f1 f2) = ?todo_compileDecodePair
@@ -99,6 +102,7 @@ namespace Compile
   compileEncode Fail = ?todo_compileEncodeFail
   compileEncode (Pure x) = ?todo_compileEncodePure
   compileEncode (Ignore f def) = ?todo_compileEncodeIgnore
+  compileEncode (Choice f1 f2) = ?todo_compileEncodeChoice
   compileEncode (Repeat len f) = ?todo_compileEncodeRepeat
   compileEncode (Tuple fs) = ?todo_compileEncodeTuple
   compileEncode (Pair f1 f2) = ?todo_compileEncodePair