module Data.CatQueue

import Data.List.Properties
import Interfaces.Verified

%hide Prelude.List.reverse
%hide Prelude.Strings.reverse
%hide Prelude.Strings.null
%hide Prelude.Strings.(++)

%default total
%access public export

data CatQueue a = MkCatQueue (List a) (List a)

data NonEmptyCatQueue : CatQueue a -> Type where
  IsNonEmptyCatQueue : Either (NonEmpty x) (NonEmpty y) ->
                       NonEmptyCatQueue (MkCatQueue x y)

data EmptyCatQueue : CatQueue a -> Type where
  IsEmptyCatQueue : EmptyCatQueue (MkCatQueue [] [])

data SingletonCatQueue : CatQueue a -> Type where
  IsSingletonCatQueueLeft : SingletonCatQueue (MkCatQueue [x] [])
  IsSingletonCatQueueRight : SingletonCatQueue (MkCatQueue [] [x])

--------------------------------------------------------------------------------
-- Implementations
--------------------------------------------------------------------------------

Uninhabited (NonEmptyCatQueue (MkCatQueue [] [])) where
  uninhabited (IsNonEmptyCatQueue (Left IsNonEmpty)) impossible
  uninhabited (IsNonEmptyCatQueue (Right IsNonEmpty)) impossible

Show q => Show (CatQueue q) where
  show (MkCatQueue xs ys) = "MkCatQueue " <+> show xs <+> " " <+> show ys

Eq q => Eq (CatQueue q) where
  (==) (MkCatQueue xs ys) (MkCatQueue zs ws) =
    xs <+> reverse ys == zs <+> reverse ws
  (/=) x y = not (x == y)

Ord q => Ord (CatQueue q) where
  compare (MkCatQueue [] []) (MkCatQueue [] []) = EQ
  compare (MkCatQueue [] []) _ = LT
  compare _ (MkCatQueue [] []) = GT
  compare (MkCatQueue xs ys) (MkCatQueue zs ws) = compare (xs <+> reverse ys) (zs <+> reverse ws)

Semigroup (CatQueue q) where
  (<+>) (MkCatQueue xs ys) (MkCatQueue zs ws) = MkCatQueue ((xs <+> reverse ys) <+> (zs <+> reverse ws)) []

Monoid (CatQueue q) where
  neutral = MkCatQueue [] []

Functor CatQueue where
  map f (MkCatQueue xs ys) = MkCatQueue (map f xs) (map f ys)

Foldable CatQueue where
  foldr f init (MkCatQueue xs ys) = foldr f init (xs <+> reverse ys)
  foldl f init (MkCatQueue xs ys) = foldl f init (xs <+> reverse ys)

--------------------------------------------------------------------------------
-- Verified implementations
--------------------------------------------------------------------------------

-- TODO: how do I formally write that this is an axiom?
private
axiomCatQueueSame : (xs : List a) -> (ys : List a) -> MkCatQueue xs ys = MkCatQueue (xs <+> reverse ys) []
axiomCatQueueSame xs ys = ?axiomCatQueueSame_rhs

-- However, we can't use this axiom due to some limitations of ITT. Even though we have an axiom saying that these
-- two CatQueues are the same, we can contradict this axiom easily:
private
inconsistentAxiom : MkCatQueue xs ys = MkCatQueue (xs <+> reverse ys) [] -> Void
inconsistentAxiom = case axiomCatQueueSame [] [1] of Refl impossible

-- This could be viewed as a reasonable compromise, since we're only using it internally to prove that other
-- properties hold. But it severely limits the ability to provide proofs for this type of data structure, specifically
-- any data structure where two different constructions are considered equal

VerifiedFunctor CatQueue where
  functorIdentity (MkCatQueue xs ys) =
    rewrite functorIdentity xs in
    rewrite functorIdentity ys in Refl
  functorComposition (MkCatQueue xs ys) g1 g2 =
    rewrite functorComposition xs g1 g2 in
    rewrite functorComposition ys g1 g2 in Refl

VerifiedSemigroup (CatQueue q) where
  semigroupOpIsAssociative (MkCatQueue ls ls') (MkCatQueue cs cs') (MkCatQueue rs rs') =
    rewrite appendAssociative (ls ++ reverse' [] ls') ((cs ++ reverse' [] cs') ++ rs ++ reverse' [] rs') [] in
    rewrite appendNilRightNeutral ((ls ++ reverse' [] ls') ++ cs ++ reverse' [] cs') in
    rewrite appendNilRightNeutral ((ls ++ reverse' [] ls') ++ (cs ++ reverse' [] cs') ++ rs ++ reverse' [] rs') in
    rewrite appendAssociative (ls ++ reverse' [] ls') (cs ++ reverse' [] cs') (rs ++ reverse' [] rs') in
    Refl

VerifiedMonoid (CatQueue q) where
  monoidNeutralIsNeutralL (MkCatQueue xs ys) =
    rewrite appendNilRightNeutral (xs ++ reverse' [] ys) in
    rewrite axiomCatQueueSame xs ys in
    Refl
  monoidNeutralIsNeutralR (MkCatQueue xs ys) =
    rewrite axiomCatQueueSame xs ys in
    Refl

--------------------------------------------------------------------------------
-- Functions
--------------------------------------------------------------------------------

-- | Test whether a queue is empty.
-- |
-- | Running time: `O(1)`
null : CatQueue a -> Bool
null (MkCatQueue [] []) = True
null _ = False

-- | Append an element to the end of the queue, creating a new queue.
-- |
-- | Running time: `O(1)`
snoc : CatQueue a -> a -> CatQueue a
snoc (MkCatQueue l r) a = MkCatQueue l (a :: r)

-- | Decompose a queue into a `Tuple` of the first element and the rest of the queue.
-- |
-- | Running time: `O(1)`
-- |
-- | Note that any single operation may run in `O(n)`.
uncons : (q : CatQueue a) -> {auto prf : NonEmptyCatQueue q} -> (a, CatQueue a)
uncons (MkCatQueue [] []) {prf} = absurd prf
uncons (MkCatQueue [] (x :: xs)) = uncons_prf (x :: xs) {prf' = reverseNonEmpty (x :: xs) IsNonEmpty}
  where
    uncons_prf : (l : List a) -> {auto prf : NonEmpty l} -> {prf' : NonEmpty (reverse l)} -> (a, CatQueue a)
    uncons_prf l = assert_total $ uncons (MkCatQueue (reverse l) [])
uncons (MkCatQueue (x :: xs) ys) = (x, (MkCatQueue xs ys))

-- | Decompose a queue into a `Tuple` of the first element and the rest of the queue.
-- |
-- | Running time: `O(1)`
-- |
-- | Note that any single operation may run in `O(n)`.
uncons' : CatQueue a -> Maybe (a, (CatQueue a))
uncons' (MkCatQueue [] []) = Nothing
uncons' (MkCatQueue [] r) = assert_total $ uncons' (MkCatQueue (reverse r) [])
uncons' (MkCatQueue (a :: as) r) = Just (a, (MkCatQueue as r))

--------------------------------------------------------------------------------
-- Properties
--------------------------------------------------------------------------------

snocNotEmpty : (x : a) -> (q : CatQueue a) -> {auto prf : EmptyCatQueue q} -> NonEmptyCatQueue (snoc q x)
snocNotEmpty x q@(MkCatQueue [] []) = the (NonEmptyCatQueue (snoc q x)) (IsNonEmptyCatQueue (Right IsNonEmpty))

singletonNonEmpty : SingletonCatQueue q -> NonEmptyCatQueue q
singletonNonEmpty IsSingletonCatQueueLeft = IsNonEmptyCatQueue (Left IsNonEmpty)
singletonNonEmpty IsSingletonCatQueueRight = IsNonEmptyCatQueue (Right IsNonEmpty)

snocEmptySingleton : (x : a) -> (q : CatQueue a) -> {auto prf : EmptyCatQueue q} -> SingletonCatQueue (snoc q x)
snocEmptySingleton x (MkCatQueue [] []) = IsSingletonCatQueueRight

nonEmptyNotNull : (q : CatQueue a) -> {auto prf : NonEmptyCatQueue q} -> null q = False
nonEmptyNotNull (MkCatQueue [] []) {prf} = absurd prf
nonEmptyNotNull (MkCatQueue (x :: xs) []) = Refl
nonEmptyNotNull (MkCatQueue [] (y :: ys)) = Refl
nonEmptyNotNull (MkCatQueue (x :: xs) (y :: ys)) = Refl

Uninhabited (False = True) where
  uninhabited Refl impossible

nullDecidable : (q : CatQueue a) -> Dec (null q = True)
nullDecidable (MkCatQueue [] []) = Yes Refl
nullDecidable (MkCatQueue (x::xs) []) = No uninhabited
nullDecidable (MkCatQueue [] (x::xs)) = No uninhabited
nullDecidable (MkCatQueue (x::xs) (y::ys)) = No uninhabited


||| Test extended record syntax
data NotZero : Nat -> Type where
  Is : {n : Nat} -> NotZero (S n)

record Positive (n : Nat) {auto 0 pos : NotZero n} where
  constructor Check

a : Positive 1
a = Check

b : Positive 2
b = Check

{- Will not type-check
c : Positive 0
-}

data KindOfString = ASCII | UTF

UTForASCII : KindOfString -> Type
UTForASCII UTF = String
UTForASCII ASCII = List Char   --- Just to demonstrate

record FlexiString { default UTF k : KindOfString} where
  constructor MkFlexiString
  val : UTForASCII k

c : FlexiString
c = MkFlexiString "hello"

d : FlexiString {k = ASCII}
d = MkFlexiString ['h', 'i']


module Main

-- First iteration, complected number generation with labeling

labelFrom : Integer -> List a -> List (Integer, a)
labelFrom k [] = []
labelFrom k (x :: xs) = (k, x) :: labelFrom (k+1) xs

label : List a -> List (Integer, a)
label = labelFrom 0

-- Second iteration, split number generation from labeling

countFrom : Integer -> List Integer
countFrom n = n :: countFrom (n+1)

labelWith : List Integer -> List a -> List (Integer, a)
labelWith _ []  = []
labelWith (x :: xs) (y :: ys) = (x, y) :: labelWith xs ys

-- this works on the REPL because it's lazy
label' : List a -> List (Integer, a)
label' = labelWith (countFrom 0)

-- Third iteration, Infinite Lists!

data InfList : Type -> Type where
  (::) : (value : elem) -> Inf (InfList elem) -> InfList elem
-- there's no [] constructor because infinite lists just don't end

-- countFrom' is a corecursive function that returns codata
total countFrom' : Integer -> InfList Integer
countFrom' x = x :: countFrom' (x + 1)

getPrefix : (count : Nat) -> InfList a -> List a
getPrefix Z xs = []
getPrefix (S k) (value :: xs) = value :: getPrefix k xs

main : IO ()
main = print $ getPrefix 10 (countFrom' 0)

-- the following line doesn't work:
-- main = print $ label' [1,2,3]


module Num

%default total

{-
  interface Num ty where
    (+) : ty -> ty -> ty
    (*) : ty -> ty -> ty
    fromInteger : Integer -> ty

  interface Num ty => Neg ty where
    negate : ty -> ty
    (-) : ty -> ty -> ty
    abs : ty -> ty

  interface Num ty => Integral ty  where
    div  : ty -> ty -> ty
    mod : ty -> ty -> ty

  interface Num ty => Fractional ty where
    (/) : ty -> ty -> ty
    recip : ty -> ty

    recip x = 1 / x
-}


module Quantities.ImperialUnits

import Quantities.Core
import Quantities.SIBaseQuantities
import Quantities.SIPrefixes
import Quantities.SIBaseUnits
import Quantities.SIDerivedQuantities
import Quantities.NonSIUnits

%default total
%access public export

-- Based on http://en.wikipedia.org/wiki/Imperial_units

-- Length

Thou : ElemUnit Length
Thou = < one "th" equals 25.4 (micro Metre) >
Th : ElemUnit Length
Th = Thou

Inch : ElemUnit Length
Inch = < one "in" equals 2.54 Centimetre >
In_ : ElemUnit Length
In_ = Inch

Foot : ElemUnit Length
Foot = < one "ft" equals 12 Inch >
Ft : ElemUnit Length
Ft = Foot

Yard : ElemUnit Length
Yard = < one "yd" equals 3 Foot >
Yd : ElemUnit Length
Yd = Yard

Chain : ElemUnit Length
Chain = < one "ch" equals 22 Yard >
Ch : ElemUnit Length
Ch = Chain

Furlong : ElemUnit Length
Furlong = < one "fur" equals 10 Chain >
Fur : ElemUnit Length
Fur = Furlong

Mile : ElemUnit Length
Mile = < one "mi" equals 1760 Yard >
Mi : ElemUnit Length
Mi = Mile

League : ElemUnit Length
League = < one "lea" equals 3 Mile >
Lea : ElemUnit Length
Lea = League

-- Maritime units

Fathom : ElemUnit Length
Fathom = < one "ftm" equals 6.08 Foot >
Ftm : ElemUnit Length
Ftm = Fathom

Cable : ElemUnit Length
Cable = < one "cable" equals 608 Foot >

NauticalMile : ElemUnit Length
NauticalMile = < one "nmi" equals 1852 Metre >
Nmi : ElemUnit Length
Nmi = NauticalMile

-- Gunter's survey units

Link : ElemUnit Length
Link = < one "link" equals (1/100) Chain >

Rod : ElemUnit Length
Rod = < one "rod" equals (1/4) Chain >

-- Speed

Knot : ElemUnit Speed
Knot = < one "kn" equals 1 (NauticalMile <//> Hour) >
Kn : ElemUnit Speed
Kn = Knot

-- Area

Perch : ElemUnit Area
Perch = < one "perch" equals 1 (Rod ^^ 2) >

Rood : ElemUnit Area
Rood = < one "rood" equals 1 (Furlong <**> Rod) >

Acre : ElemUnit Area
Acre = < one "acre" equals 1 (Furlong <**> Chain) >

-- Volume

FluidOunce : ElemUnit Volume
FluidOunce = < one "floz" equals 28.4130625 (milli $ (deci Metre) ^^ 3) >
Floz : ElemUnit Volume
Floz = FluidOunce

Gill : ElemUnit Volume
Gill = < one "gi" equals 5 FluidOunce >
Gi : ElemUnit Volume
Gi = Gill

Pint : ElemUnit Volume
Pint = < one "pt" equals 20 FluidOunce >
Pt : ElemUnit Volume
Pt = Pint

Quart : ElemUnit Volume
Quart = < one "qt" equals 40 FluidOunce >
Qt : ElemUnit Volume
Qt = Quart

Gallon : ElemUnit Volume
Gallon = < one "gal" equals 160 FluidOunce >
Gal : ElemUnit Volume
Gal = Gallon

-- British apothecaries' volume measures

Minim : ElemUnit Volume
Minim = < one "min" equals 59.1938802083 (micro $ (deci Metre) ^^ 3) >
Min : ElemUnit Volume
Min = Minim

FluidScruple : ElemUnit Volume
FluidScruple = < one "fls" equals 20 Minim >
Fls : ElemUnit Volume
Fls = FluidScruple

FluidDrachm : ElemUnit Volume
FluidDrachm = < one "fldr" equals 3 FluidScruple >
Fldr : ElemUnit Volume
Fldr = FluidDrachm

-- Mass

Pound : ElemUnit Mass
Pound = < one "lb" equals 453.59237 Gram >
Lb : ElemUnit Mass
Lb = Pound

Grain : ElemUnit Mass
Grain = < one "gr" equals (1/7000) Pound >
Gr : ElemUnit Mass
Gr = Grain

Drachm : ElemUnit Mass
Drachm = < one "dr" equals (1/256) Pound >
Dr : ElemUnit Mass
Dr = Drachm

Ounce : ElemUnit Mass
Ounce = < one "oz" equals (1/16) Pound >
Oz : ElemUnit Mass
Oz = Ounce

Stone : ElemUnit Mass
Stone = < one "st" equals 14 Pound >
St : ElemUnit Mass
St = Stone

Quarter : ElemUnit Mass
Quarter = < one "qtr" equals 28 Pound >
Qtr : ElemUnit Mass
Qtr = Quarter

Hundredweight : ElemUnit Mass
Hundredweight = < one "cwt" equals 112 Pound >
Cwt : ElemUnit Mass
Cwt = Hundredweight

Ton : ElemUnit Mass
Ton = < one "ton" equals 2240 Pound >

-- Energy

FootPound : ElemUnit Energy
FootPound = < one "ftlb" equals 1 (Foot <**> Pound <**> G_0) >
Ftlb : ElemUnit Energy
Ftlb = FootPound

-- Power

MechanicalHorsepower : ElemUnit Power
MechanicalHorsepower = < one "hp" equals 550 (FootPound <//> Second) >
ImperialHorsepower : ElemUnit Power
ImperialHorsepower = MechanicalHorsepower
Horsepower : ElemUnit Power
Horsepower = MechanicalHorsepower
Hp : ElemUnit Power
Hp = MechanicalHorsepower


import Data.String
import System

readNumber : IO (Maybe Nat)
readNumber =
    do numstr <- getLine
       pure (parsePositive numstr)

-- worst random number generator
rand : (min : Integer) -> (max : Integer) -> IO (Nat)
rand min max = do secs <- time
                  let n = (mod secs (max - min + 1)) + 1
                  pure (integerToNat n)

-- Guess the number game
guess : (target : Nat) -> (guesses : Nat) -> IO ()
guess target guesses =
               do putStrLn ("[Guess count: " ++ show guesses ++ "]")
                  putStrLn "Enter guess: "
                  Just num <- readNumber
                            | Nothing => do putStrLn "Invalid input"
                                            guess target guesses
                  case compare num target of
                       LT => do putStrLn "Too low."
                                guess target (guesses + 1)
                       EQ => putStrLn "Correct!"
                       GT => do putStrLn "Too high."
                                guess target (guesses + 1)

main : IO ()
main = do
        target <- rand 1 100
        guess target 0


import Data.List
import Data.List1
import Data.String

import System.File

simulate1 : Nat -> Nat -> Nat
simulate1 0 c = 1
simulate1 (S n) 0 = simulate1 n 6 + simulate1 n 8
simulate1 (S n) (S c) = simulate1 n c

run : String -> IO ()
run s = do let l = group $ sort $ catMaybes $ parsePositive {a=Nat} <$> (forget $ split (== ',') s)
           let n = sum $ (\l@(c ::: _) => (length $ forget $ l) * simulate1 256 c) <$> l
           putStrLn $ show n

main : IO ()
main = do Right s <- readFile "input.txt"
            | Left err => putStrLn $ show err
          run s


module AOC.Day.Three

import Data.Vect
import Data.String
import Decidable.Equality

%default total

data Bit : Type where
  Low : Bit
  High : Bit

Show Bit where
  show Low = "0"
  show High = "1"

Byte : (n : Nat) -> Type
Byte n = Vect n Bit

-- The only problem with this is that I now need to prove that all inputs
-- provided are of the same length. What fun.
data Binary : Nat -> Type where
  BE : Binary Z
  B0 : Binary n -> Binary (S n)
  B1 : Binary n -> Binary (S n)

export
Show (Binary n) where
  show BE = ""
  show (B0 b) = "0" ++ show b
  show (B1 b) = "1" ++ show b

----------------------------------------------------------------------------
-- Code I did not need hooray ----------------------------------------------
----------------------------------------------------------------------------

toBinary' : (s : List Char) -> Maybe (Binary (length s))
toBinary' [] = Just BE
toBinary' ('0' :: str) = (toBinary' str) >>= (\bin => Just $ B0 bin)
toBinary' ('1' :: str) = (toBinary' str) >>= (\bin => Just $ B1 bin)
toBinary' _ = Nothing

-- This works only if the type is unpacked in the type. Otherwise there is a
-- conflict in the length function used.
toBinary : (s : String) -> Maybe (Binary (length (unpack s)))
toBinary s = toBinary' (unpack s)

public export
Eq (Binary n) where
  (==) BE BE = False
  (==) (B0 x) (B0 y) = x == y
  (==) (B0 x) (B1 y) = False
  (==) (B1 x) (B0 y) = False
  (==) (B1 x) (B1 y) = x == y

-- The new Control.Function defines the `Injective` interface, which would make
-- these definitions unnecessary.
B0Injective : (0 left, right : Binary n) -> B0 left = B0 right -> left = right
B0Injective _ _ Refl = Refl

B1Injective : (0 left, right : Binary n) -> B1 left = B1 right -> left = right
B1Injective _ _ Refl = Refl

-- Sweet, I don't actually need this for the exactLength function
public export
DecEq (Binary n) where
  decEq BE BE = Yes Refl
  decEq (B0 x) (B0 y) with (decEq x y)
    decEq (B0 x) (B0 y) | (Yes prf) = Yes (cong B0 prf)
    decEq (B0 x) (B0 y) | (No contra) = No $ \h : (B0 x = B0 y) => contra $ B0Injective x y h
  decEq (B1 x) (B1 y) with (decEq x y)
    decEq (B1 x) (B1 y) | (Yes prf) = Yes (cong B1 prf)
    decEq (B1 x) (B1 y) | (No contra) = No $ \h : (B1 x = B1 y) => contra $ B1Injective x y h
  decEq (B0 x) (B1 y) = No B0B1impossible
    where
      B0B1impossible : (B0 x = B1 y) -> Void
      B0B1impossible Refl impossible
  decEq (B1 x) (B0 y) = No B1B0impossible
    where
      B1B0impossible : (B1 x = B0 y) -> Void
      B1B0impossible Refl impossible

----------------------------------------------------------------------------
-- Proofs required for parsing ---------------------------------------------
----------------------------------------------------------------------------

exactLength : {m : Nat} -> -- expected at run-time
              (len : Nat) -> (xs : Binary m) -> Maybe (Binary len)
exactLength {m} len xs with (decEq m len)
  exactLength {m = m} m xs | (Yes Refl) = Just xs
  exactLength {m = m} len xs | (No contra) = Nothing

-- Stolen from https://github.com/jumper149/AoC2021/blob/main/03/src/Main.idr
exactLengths : (len : Nat) -> Traversable t => t (n ** Binary n) -> Maybe (t (Binary len))
exactLengths len xs = traverse (\ x => exactLength len x.snd) xs

----------------------------------------------------------------------------
-- Actual parsing code -----------------------------------------------------
----------------------------------------------------------------------------

toBinaryDep' : (s : List Char) -> Maybe (n ** Binary n)
toBinaryDep' [] = Just (0 ** BE)
toBinaryDep' ('0' :: str) = (toBinaryDep' str) >>= (\(n ** bin) => Just $ (S n ** B0 bin))
toBinaryDep' ('1' :: str) = (toBinaryDep' str) >>= (\(n ** bin) => Just $ (S n ** B1 bin))
toBinaryDep' _ = Nothing

export
toBinaryDep : (s : String) -> Maybe (n ** Binary n)
toBinaryDep s = toBinaryDep' (unpack s)

export
parseBinary : List (n ** Binary n) -> Maybe (m ** List (Binary m))
parseBinary [] = Just (0 ** [])
parseBinary ((len ** bin) :: ys) = do
    list <- exactLengths len ys
    pure (len ** bin :: list)

  -- Ok, this does not work for some reason or another
  -- Prove that the size of the binary numbers in ys is the same as the size of
  -- bin.

  -- (ys_len ** ys) <- parseBinary ys
  -- bin <- exactLength ys_len bin

  -- -- With the sizes resolved, reconstruct with the dependent pair on the outside
  -- -- of the list.
  -- pure (ys_len ** bin :: ys)

----------------------------------------------------------------------------
-- Implementing Vect like interfaces for Binary ----------------------------
----------------------------------------------------------------------------

-- Most of these functions are just to make it easier to answer the AOC questions, since they involve transforming the individual bits into a

binaryToVect : Binary n -> Vect n Bool
binaryToVect BE = []
binaryToVect (B0 x) = False :: (binaryToVect x)
binaryToVect (B1 x) = True :: (binaryToVect x)

mapBinary : (Bool -> a) -> Binary n -> Vect n a
mapBinary f = map f . binaryToVect

-- day3 : List String -> (Integer, Integer)
-- day3 binary = ?something


> module Main

> import Data.So

> ifTrue        :   So True -> Nat
> ifTrue Oh     =   S Z

> ifFalse       :   So False -> Nat
> ifFalse Oh impossible

> test          :   (f : Nat -> Bool) -> (n : Nat) -> So (f n) -> Nat
> test f n x   with   (f n)
>               |   True     =  ifTrue  x
>               |   False    =  ifFalse x

> main : IO ()
> main = printLn (test ((S 4) ==) 5 Oh)


module Control.Optics.Getter

import public Control.Optics.Types

export
view : Getting a s a -> s -> a
view l = runConst . applyMor (l (Mor MkConst))

infixl 8 ^.
export
(^.) : s -> Getting a s a -> a
s ^. l = view l s

export
to : (Profunctor p, Contravariant f) => (s -> a) -> Simple (Optic p f) s a
to k = dimap k (contramap k)


module Data.Functor.Compose

public export
data Compose : (f : Type -> Type) -> (g : Type -> Type) -> Type -> Type where
  MkCompose : f (g x) -> Compose f g x

public export
getCompose : Compose f g a -> f (g a)
getCompose (MkCompose x) = x

public export
implementation (Functor f, Functor g) => Functor (Compose f g) where
  map f (MkCompose x) = MkCompose $ map (map f) x


------------------------------------------------------------------------
-- This module is based on the following papers:

-- Categories of Containers
-- Abbott, Altenkirch, Ghani

-- Derivatives of Containers
-- Abbott, Altenkirch, Ghani, McBride
------------------------------------------------------------------------

module Data.Container

import Data.Either
import Decidable.Equality

%default total

------------------------------------------------------------------------
-- Container and their morphisms
-- * Extension is a functor from Container to Type

-- Objects of the category of containers
namespace Container

  public export
  record Container where
    constructor MkContainer
    Shape : Type
    Position : Shape -> Type

  public export
  record Extension (c : Container) (x : Type) where
    constructor MkExtension
    shape    : Shape c
    payloads : Position c shape -> x

  ||| The image of a container by @Extension@ is a functor
  public export
  Functor (Extension c) where map f (MkExtension s p) = MkExtension s (f . p)

-- Morphisms of the category of containers
namespace Morphism

  public export
  record Morphism (c, d : Container) where
    constructor MkMorphism
    shapeMorphism : Shape c -> Shape d
    positionMorphism : {s : Shape c} -> Position d (shapeMorphism s) -> Position c s

  public export
  Extension : Morphism c d -> Extension c x -> Extension d x
  Extension phi (MkExtension s p)
    = MkExtension (shapeMorphism phi s) (p . positionMorphism phi)

------------------------------------------------------------------------
-- Combinators to build containers

namespace Combinators

  -- Constant
  public export
  Const : Type -> Container
  Const k = MkContainer k (const Void)

  export
  toConst : k -> Extension (Const k) x
  toConst v = MkExtension v absurd

  export
  fromConst : Extension (Const k) x -> k
  fromConst (MkExtension v _) = v

  -- Identity
  public export
  Identity : Container
  Identity = MkContainer () (\ () => ())

  export
  toIdentity : x -> Extension Identity x
  toIdentity v = MkExtension () (const v)

  export
  fromIdentity : Extension Identity x -> x
  fromIdentity (MkExtension () chld) = chld ()

  -- Composition
  public export
  Compose : (d, c : Container) -> Container
  Compose d c = MkContainer
    (Extension d (Shape c))
    (\ (MkExtension shp chld) => (p : Position d shp ** Position c (chld p)))

  export
  toCompose : (Extension d . Extension c) x -> Extension (Compose d c) x
  toCompose (MkExtension shp1 chld)
    = MkExtension (MkExtension shp1 (shape . chld)) (\ (p ** q) => payloads (chld p) q)

  export
  fromCompose : Extension (Compose d c) x -> (Extension d . Extension c) x
  fromCompose (MkExtension (MkExtension shp1 shp2) chld)
    = MkExtension shp1 (\ p => MkExtension (shp2 p) (\ q => chld (p ** q)))

  -- Direct sum
  public export
  Sum : (c, d : Container) -> Container
  Sum c d = MkContainer (Either (Shape c) (Shape d)) (either (Position c) (Position d))

  export
  toSum : Either (Extension c x) (Extension d x) -> Extension (Sum c d) x
  toSum (Left (MkExtension shp chld)) = MkExtension (Left shp) chld
  toSum (Right (MkExtension shp chld)) = MkExtension (Right shp) chld

  export
  fromSum : Extension (Sum c d) x -> Either (Extension c x) (Extension d x)
  fromSum (MkExtension (Left shp) chld) = Left (MkExtension shp chld)
  fromSum (MkExtension (Right shp) chld) = Right (MkExtension shp chld)

  -- Pairing
  public export
  Pair : (c, d : Container) -> Container
  Pair c d = MkContainer (Shape c, Shape d) (\ (p, q) => Either (Position c p) (Position d q))

  export
  toPair : (Extension c x, Extension d x) -> Extension (Pair c d) x
  toPair (MkExtension shp1 chld1, MkExtension shp2 chld2)
    = MkExtension (shp1, shp2) (either chld1 chld2)

  export
  fromPair : Extension (Pair c d) x -> (Extension c x, Extension d x)
  fromPair (MkExtension (shp1, shp2) chld)
    = (MkExtension shp1 (chld . Left), MkExtension shp2 (chld . Right))

  -- Branching over a Type
  public export
  Exponential : Type -> Container -> Container
  Exponential k c = MkContainer (k -> Shape c) (\ p => (v : k ** Position c (p v)))

  export
  toExponential : (k -> Extension c x) -> Extension (Exponential k c) x
  toExponential f = MkExtension (shape . f) (\ (v ** p) => payloads (f v) p)

  export
  fromExponential : Extension (Exponential k c) x -> (k -> Extension c x)
  fromExponential (MkExtension  shp chld) k = MkExtension (shp k) (\ p => chld (k ** p))

------------------------------------------------------------------------
-- Taking various fixpoints of containers

namespace Initial

  public export
  data W : Container -> Type where
    MkW : Extension c (W c) -> W c

  export
  map : Morphism c d -> W c -> W d
  map f (MkW (MkExtension shp chld)) = MkW $ Extension f (MkExtension shp (\ p => map f (chld p)))
  --  Container.map inlined because of -------------------^
  --  termination checking

  export
  foldr : (Extension c x -> x) -> W c -> x
  foldr alg (MkW (MkExtension shp chld)) = alg (MkExtension shp (\ p => foldr alg (chld p)))

  export
  para : (Extension c (x, W c) -> x) -> W c -> x
  para alg (MkW (MkExtension shp chld)) = alg (MkExtension shp (\ p => let w = chld p in (para alg w, w)))

namespace Monad

  ||| @Free@ is a wrapper around @W@ to make it inference friendly.
  ||| Without this wrapper, neither @pure@ nor @bind@ are able to infer their @c@ argument.
  public export
  record Free (c : Container) (x : Type) where
    constructor MkFree
    runFree : W (Sum c (Const x))

  export
  pure : x -> Free c x
  pure x = MkFree $ MkW (toSum (Right (toConst x)))

  export
  (>>=) : Free c x -> (x -> Free c y) -> Free c y
  (>>=) (MkFree mx) k = foldr (alg . fromSum {c} {d = Const x}) mx where

    alg : Either (Extension c (Free c y)) (Extension (Const x) (Free c y)) -> Free c y
    alg  = either (MkFree . MkW . toSum {c} {d = Const y} . Left . map (runFree {c}))
                  (k . fromConst {k = x})

  export
  join : Free c (Free c x) -> Free c x
  join = (>>= id)

namespace Final

  public export
  data M : Container -> Type where
    MkM : Extension c (Inf (M c)) -> M c

  export
  unfoldr : (s -> Extension c s) -> s -> M c
  unfoldr next seed =
    let (MkExtension shp chld) = next seed in
    MkM (MkExtension shp (\ p => unfoldr next (chld p)))

namespace Comonad

  ||| @Cofree@ is a wrapper around @M@ to make it inference friendly.
  ||| Without this wrapper, neither @extract@ nor @extend@ are able to infer their @c@ argument.
  public export
  record Cofree (c : Container) (x : Type) where
    constructor MkCofree
    runCofree : M (Pair (Const x) c)

  export
  extract : Cofree c x -> x
  extract (MkCofree (MkM m)) = fst (shape m)

  export
  extend : (Cofree c a -> b) -> Cofree c a -> Cofree c b
  extend alg = MkCofree . unfoldr next . runCofree where

    next : M (Pair (Const a) c) -> Extension (Pair (Const b) c) (M (Pair (Const a) c))
    next m@(MkM layer) =
      let (_, (MkExtension shp chld)) = fromPair {c = Const a} layer in
      let b = toConst (alg (MkCofree m)) in
      toPair (b, MkExtension shp (\ p => chld p))
-- Eta-expanded to force Inf ------^

  export
  duplicate : Cofree c a -> Cofree c (Cofree c a)
  duplicate = extend id

------------------------------------------------------------------------
-- Derivative

namespace Derivative

  public export
  Derivative : Container -> Container
  Derivative c = MkContainer
    (s : Shape c ** Position c s)
    (\ (s ** p) => (p' : Position c s ** Not (p === p')))

  export
  hole : (v : Extension (Derivative c) x) -> Position c (fst (shape v))
  hole (MkExtension (shp ** p) _) = p

  export
  unplug : (v : Extension c x) -> Position c (shape v) -> (Extension (Derivative c) x, x)
  unplug (MkExtension shp chld) p = (MkExtension (shp ** p) (chld . fst), chld p)

  export
  plug : (v : Extension (Derivative c) x) -> DecEq (Position c (fst (shape v))) => x -> Extension c x
  plug (MkExtension (shp ** p) chld) x = MkExtension shp $ \ p' => case decEq p p' of
    Yes eq => x
    No neq => chld (p' ** neq)

  export
  toConst : Extension (Const Void) x -> Extension (Derivative (Const k)) x
  toConst v = absurd (fromConst v)

  export
  fromConst : Extension (Derivative (Const k)) x -> Extension (Const Void) x
  fromConst v = absurd (hole {c = Const _} v)

  export
  toIdentity : Extension (Derivative Identity) x
  toIdentity = MkExtension (() ** ()) (\ (() ** eq) => absurd (eq Refl))

  export
  toSum : Extension (Sum (Derivative c) (Derivative d)) x ->
          Extension (Derivative (Sum c d)) x
  toSum v = case fromSum {c = Derivative c} {d = Derivative d} v of
    Left (MkExtension (shp ** p) chld) => MkExtension (Left shp ** p) chld
    Right (MkExtension (shp ** p) chld) => MkExtension (Right shp ** p) chld

  export
  fromSum : Extension (Derivative (Sum c d)) x ->
            Extension (Sum (Derivative c) (Derivative d)) x
  fromSum (MkExtension (shp ** p) chld) = toSum {c = Derivative c} {d = Derivative d} $ case shp of
    Left shp => Left (MkExtension (shp ** p) chld)
    Right shp => Right (MkExtension (shp ** p) chld)

  export
  toPair : Extension (Sum (Pair (Derivative c) d) (Pair c (Derivative d))) x ->
           Extension (Derivative (Pair c d)) x
  toPair v = case fromSum {c = Pair (Derivative c) d} {d = Pair c (Derivative d)} v of
    Left p => let (MkExtension (shp1 ** p1) chld1, MkExtension shp2 chld2) = fromPair {c = Derivative c} p in
              MkExtension ((shp1, shp2) ** Left p1) $ \ (p' ** neq) => case p' of
                  Left p1' => chld1 (p1' ** (neq . cong Left))
                  Right p2' => chld2 p2'
    Right p => let (MkExtension shp1 chld1, MkExtension (shp2 ** p2) chld2) = fromPair {c} {d = Derivative d} p in
               MkExtension ((shp1, shp2) ** Right p2) $ \ (p' ** neq) => case p' of
                  Left p1' => chld1 p1'
                  Right p2' => chld2 (p2' ** (neq . cong Right))

  export
  fromPair : Extension (Derivative (Pair c d)) x ->
             Extension (Sum (Pair (Derivative c) d) (Pair c (Derivative d))) x
  fromPair (MkExtension ((shp1, shp2) ** p) chld) = case p of
    Left p1 => toSum {c = Pair (Derivative c) d} {d = Pair c (Derivative d)}
                     (Left (MkExtension ((shp1 ** p1), shp2) $ either
                         (\ p1' => chld (Left (DPair.fst p1') ** DPair.snd p1' . injective))
                         (\ p2 => chld (Right p2 ** absurd))))
    Right p2 => toSum {c = Pair (Derivative c) d} {d = Pair c (Derivative d)}
                     (Right (MkExtension (shp1, (shp2 ** p2)) $ either
                         (\ p1 => chld (Left p1 ** absurd))
                         (\ p2' => chld (Right (DPair.fst p2') ** DPair.snd p2' . injective))))

  export
  fromCompose : Extension (Derivative (Compose c d)) x ->
                Extension (Pair (Derivative d) (Compose (Derivative c) d)) x
  fromCompose (MkExtension (MkExtension shp1 shp2 ** (p1 ** p2)) chld)
    = toPair (left, right) where

      left : Extension (Derivative d) x
      left = MkExtension (shp2 p1 ** p2)
           $ \ (p2' ** neqp2) => chld ((p1 ** p2') ** neqp2 . mkDPairInjectiveSnd)

      right : Extension (Compose (Derivative c) d) x
      right = toCompose
            $ MkExtension (shp1 ** p1)
            $ \ (p1' ** neqp1) => MkExtension (shp2 p1')
                                 $ \ p2' => chld ((p1' ** p2') ** (neqp1 . cong fst))

  export
  toCompose : ((s : _) -> DecEq (Position c s)) -> ((s : _) -> DecEq (Position d s)) ->
              Extension (Pair (Derivative d) (Compose (Derivative c) d)) x ->
              Extension (Derivative (Compose c d)) x
  toCompose dec1 dec2 v with (fromPair {c = Derivative d} {d = Compose (Derivative c) d} v)
    toCompose dec1 dec2 v | (MkExtension (shp2 ** p2) chld2, w) with (fromCompose w)
      toCompose dec1 dec2 v
        | (MkExtension (shp2 ** p2) chld2, w)
        | (MkExtension (shp1 ** p1) chld1)
        = MkExtension (MkExtension shp1 (\ p1' => shp2' p1' (decEq @{dec1 shp1} p1 p1')) **
                      (p1 ** (p2' (decEq @{dec1 shp1} p1 p1))))
        $ \ ((p1' ** p2'') ** neq) => chld2' p1' p2'' neq

         where
          shp2' : (p1' : Position c shp1) -> Dec (p1 === p1') -> Shape d
          shp2' p1' (Yes eq) = shp2
          shp2' p1' (No neq) = shape (chld1 (p1' ** neq))

          p2' : (eq : Dec (p1 === p1)) -> Position d (shp2' p1 eq)
          p2' (Yes Refl) = p2
          p2' (No neq)   = absurd (neq Refl)

          chld2' : (p1' : Position c shp1) ->
                   (p2'' : Position d (shp2' p1' (decEq @{dec1 shp1} p1 p1'))) ->
                   (neq : Not (MkDPair p1 (p2' (decEq @{dec1 shp1} p1 p1)) = MkDPair p1' p2'')) -> x
          chld2' p1' p2'' neq with (decEq @{dec1 shp1} p1 p1')
            chld2' p1' p2'' neq | No neq1 = payloads (chld1 (p1' ** neq1)) p2''
            chld2' _ p2'' neq | Yes Refl with (decEq @{dec1 shp1} p1 p1)
              chld2' _ p2'' neq | Yes Refl | No argh = absurd (argh Refl)
              chld2' _ p2'' neq | Yes Refl | Yes Refl with (decEq @{dec2 shp2} p2 p2'')
                chld2' _ p2'' neq | Yes Refl | Yes Refl | No neq2 = chld2 (p2'' ** neq2)
                chld2' _ _ neq | Yes Refl | Yes Refl | Yes Refl = absurd (neq Refl)


module Leap

export
isLeap : Int -> Bool
isLeap year =
  (divBy 4 && not (divBy 100)) || divBy 400
  where divBy : Int -> Bool
        divBy n = (year `mod` n) == 0

export
version : String
version = "1.0.0"


||| Spec: https://webassembly.github.io/spec/core/syntax/modules.html#memories
module WebAssembly.Structure.Modules.Memories

import WebAssembly.Structure.Types

import Decidable.Equality

-- Definition

public export
record Mem where
  constructor MkMem
  type : MemType

-- Equality

total public export
lemma_mem__type_injective : ((m1 = m2) -> Void) -> (MkMem m1 = MkMem m2) -> Void
lemma_mem__type_injective m1_not_m2 Refl = m1_not_m2 Refl

-- Decidable Equality

public export
implementation DecEq Mem where
  decEq (MkMem m1) (MkMem m2) = case decEq m1 m2 of
    No m1_not_m2 => No $ lemma_mem__type_injective m1_not_m2
    Yes Refl     => Yes Refl


module Example.Pil.GenShow

import Data.List

import Example.Pil.Gen

%default total

%hint
interestingType : Gen Type
interestingType = oneOf $ map pure $ [Int, String, Bool]

DecEq' Type where
  decEq' Int    Int    = Yes Refl
  decEq' String String = Yes Refl
  decEq' Bool   Bool   = Yes Refl
  decEq' _      _      = No

alphaChar : Gen Char
alphaChar = choose ('a', 'z')

%hint
alphaString : Gen String
alphaString = map pack $ sequence $ replicate !(choose (1, 3)) alphaChar

%hint
varName : Gen Name
varName = MkName <$> alphaString

partial
simpleValue : {a : Type} -> Gen a
simpleValue {a=Int}    = chooseAny
simpleValue {a=String} = alphaString
simpleValue {a=Bool}   = chooseAny

partial
uniFunction : {a : Type} -> Gen (a -> a)
uniFunction {a=Int}    = oneOf $ map pure $ [ (+1), (+2), \x => x - 1 ]
uniFunction {a=String} = oneOf $ map pure $ [ ("a"++), (++"z") ]
uniFunction {a=Bool}   = pure not

partial
biFunction : {a : Type} -> Gen (a -> a -> a)
biFunction {a=Int}    = oneOf $ map pure $ [ (+), (*) ]
biFunction {a=String} = pure (++)
biFunction {a=Bool}   = oneOf $ map pure $ [ (\x, y => x && y), (\x, y => x || y) ]

%hint
partial
interestingExpr : {a : Type} -> {ctx : Context} -> Gen (Expression ctx a)
interestingExpr = exprGen 3 simpleValue uniFunction biFunction

partial
someStatementGen : Gen (post ** Statement [] post)
someStatementGen = stmtGen []

partial
someStatement : (post ** Statement [] post)
someStatement = unGen someStatementGen someStdGen


module Foo

plusAssoc : plus n (plus m o) = plus (plus n m) o
plusAssoc = ?impl


Ty : Type
Ty = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty : Ty
empty = \ _, empty, _ => empty

arr : Ty -> Ty -> Ty
arr = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con : Type
Con = (Con : Type)
 ->(nil  : Con)
 ->(snoc : Con -> Ty -> Con)
 -> Con

nil : Con
nil = \ con, nil, snoc => nil

snoc : Con -> Ty -> Con
snoc = \ g, a, con, nil, snoc => snoc (g con nil snoc) a

Var : Con -> Ty -> Type
Var = \ g, a =>
    (Var : Con -> Ty -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var (snoc g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var g a -> Var (snoc g b) a)
 -> Var g a

vz : {g : _}-> {a : _} -> Var (snoc g a) a
vz = \ var, vz, vs => vz _ _

vs : {g : _} -> {B : _} -> {a : _} -> Var g a -> Var (snoc g B) a
vs = \ x, var, vz, vs => vs _ _ _ (x var vz vs)

Tm : Con -> Ty -> Type
Tm = \ g, a =>
    (Tm    : Con -> Ty -> Type)
 -> (var   : (g : _) -> (a : _) -> Var g a -> Tm g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm (snoc g a) B -> Tm g (arr a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm g (arr a B) -> Tm g a -> Tm g B)
 -> Tm g a

var : {g : _} -> {a : _} -> Var g a -> Tm g a
var = \ x, tm, var, lam, app => var _ _ x

lam : {g : _} -> {a : _} -> {B : _} -> Tm (snoc g a) B -> Tm g (arr a B)
lam = \ t, tm, var, lam, app => lam _ _ _ (t tm var lam app)

app : {g:_}->{a:_}->{B:_} -> Tm g (arr a B) -> Tm g a -> Tm g B
app = \ t, u, tm, var, lam, app => app _ _ _ (t tm var lam app) (u tm var lam app)

v0 : {g:_}->{a:_} -> Tm (snoc g a) a
v0 = var vz

v1 : {g:_}->{a:_}-> {B:_}-> Tm (snoc (snoc g a) B) a
v1 = var (vs vz)

v2 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm (snoc (snoc (snoc g a) B) C) a
v2 = var (vs (vs vz))

v3 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm (snoc (snoc (snoc (snoc g a) B) C) D) a
v3 = var (vs (vs (vs vz)))

v4 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm (snoc (snoc (snoc (snoc (snoc g a) B) C) D) E) a
v4 = var (vs (vs (vs (vs vz))))

test : {g:_}-> {a:_} -> Tm g (arr (arr a a) (arr a a))
test  = lam (lam (app v1 (app v1 (app v1 (app v1 (app v1 (app v1 v0)))))))
Ty1 : Type
Ty1 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty1 : Ty1
empty1 = \ _, empty, _ => empty

arr1 : Ty1 -> Ty1 -> Ty1
arr1 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con1 : Type
Con1 = (Con1 : Type)
 ->(nil  : Con1)
 ->(snoc : Con1 -> Ty1 -> Con1)
 -> Con1

nil1 : Con1
nil1 = \ con, nil1, snoc => nil1

snoc1 : Con1 -> Ty1 -> Con1
snoc1 = \ g, a, con, nil1, snoc1 => snoc1 (g con nil1 snoc1) a

Var1 : Con1 -> Ty1 -> Type
Var1 = \ g, a =>
    (Var1 : Con1 -> Ty1 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var1 (snoc1 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var1 g a -> Var1 (snoc1 g b) a)
 -> Var1 g a

vz1 : {g : _}-> {a : _} -> Var1 (snoc1 g a) a
vz1 = \ var, vz1, vs => vz1 _ _

vs1 : {g : _} -> {B : _} -> {a : _} -> Var1 g a -> Var1 (snoc1 g B) a
vs1 = \ x, var, vz1, vs1 => vs1 _ _ _ (x var vz1 vs1)

Tm1 : Con1 -> Ty1 -> Type
Tm1 = \ g, a =>
    (Tm1    : Con1 -> Ty1 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var1 g a -> Tm1 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm1 (snoc1 g a) B -> Tm1 g (arr1 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm1 g (arr1 a B) -> Tm1 g a -> Tm1 g B)
 -> Tm1 g a

var1 : {g : _} -> {a : _} -> Var1 g a -> Tm1 g a
var1 = \ x, tm, var1, lam, app => var1 _ _ x

lam1 : {g : _} -> {a : _} -> {B : _} -> Tm1 (snoc1 g a) B -> Tm1 g (arr1 a B)
lam1 = \ t, tm, var1, lam1, app => lam1 _ _ _ (t tm var1 lam1 app)

app1 : {g:_}->{a:_}->{B:_} -> Tm1 g (arr1 a B) -> Tm1 g a -> Tm1 g B
app1 = \ t, u, tm, var1, lam1, app1 => app1 _ _ _ (t tm var1 lam1 app1) (u tm var1 lam1 app1)

v01 : {g:_}->{a:_} -> Tm1 (snoc1 g a) a
v01 = var1 vz1

v11 : {g:_}->{a:_}-> {B:_}-> Tm1 (snoc1 (snoc1 g a) B) a
v11 = var1 (vs1 vz1)

v21 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm1 (snoc1 (snoc1 (snoc1 g a) B) C) a
v21 = var1 (vs1 (vs1 vz1))

v31 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm1 (snoc1 (snoc1 (snoc1 (snoc1 g a) B) C) D) a
v31 = var1 (vs1 (vs1 (vs1 vz1)))

v41 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm1 (snoc1 (snoc1 (snoc1 (snoc1 (snoc1 g a) B) C) D) E) a
v41 = var1 (vs1 (vs1 (vs1 (vs1 vz1))))

test1 : {g:_}-> {a:_} -> Tm1 g (arr1 (arr1 a a) (arr1 a a))
test1  = lam1 (lam1 (app1 v11 (app1 v11 (app1 v11 (app1 v11 (app1 v11 (app1 v11 v01)))))))
Ty2 : Type
Ty2 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty2 : Ty2
empty2 = \ _, empty, _ => empty

arr2 : Ty2 -> Ty2 -> Ty2
arr2 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con2 : Type
Con2 = (Con2 : Type)
 ->(nil  : Con2)
 ->(snoc : Con2 -> Ty2 -> Con2)
 -> Con2

nil2 : Con2
nil2 = \ con, nil2, snoc => nil2

snoc2 : Con2 -> Ty2 -> Con2
snoc2 = \ g, a, con, nil2, snoc2 => snoc2 (g con nil2 snoc2) a

Var2 : Con2 -> Ty2 -> Type
Var2 = \ g, a =>
    (Var2 : Con2 -> Ty2 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var2 (snoc2 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var2 g a -> Var2 (snoc2 g b) a)
 -> Var2 g a

vz2 : {g : _}-> {a : _} -> Var2 (snoc2 g a) a
vz2 = \ var, vz2, vs => vz2 _ _

vs2 : {g : _} -> {B : _} -> {a : _} -> Var2 g a -> Var2 (snoc2 g B) a
vs2 = \ x, var, vz2, vs2 => vs2 _ _ _ (x var vz2 vs2)

Tm2 : Con2 -> Ty2 -> Type
Tm2 = \ g, a =>
    (Tm2    : Con2 -> Ty2 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var2 g a -> Tm2 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm2 (snoc2 g a) B -> Tm2 g (arr2 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm2 g (arr2 a B) -> Tm2 g a -> Tm2 g B)
 -> Tm2 g a

var2 : {g : _} -> {a : _} -> Var2 g a -> Tm2 g a
var2 = \ x, tm, var2, lam, app => var2 _ _ x

lam2 : {g : _} -> {a : _} -> {B : _} -> Tm2 (snoc2 g a) B -> Tm2 g (arr2 a B)
lam2 = \ t, tm, var2, lam2, app => lam2 _ _ _ (t tm var2 lam2 app)

app2 : {g:_}->{a:_}->{B:_} -> Tm2 g (arr2 a B) -> Tm2 g a -> Tm2 g B
app2 = \ t, u, tm, var2, lam2, app2 => app2 _ _ _ (t tm var2 lam2 app2) (u tm var2 lam2 app2)

v02 : {g:_}->{a:_} -> Tm2 (snoc2 g a) a
v02 = var2 vz2

v12 : {g:_}->{a:_}-> {B:_}-> Tm2 (snoc2 (snoc2 g a) B) a
v12 = var2 (vs2 vz2)

v22 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm2 (snoc2 (snoc2 (snoc2 g a) B) C) a
v22 = var2 (vs2 (vs2 vz2))

v32 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm2 (snoc2 (snoc2 (snoc2 (snoc2 g a) B) C) D) a
v32 = var2 (vs2 (vs2 (vs2 vz2)))

v42 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm2 (snoc2 (snoc2 (snoc2 (snoc2 (snoc2 g a) B) C) D) E) a
v42 = var2 (vs2 (vs2 (vs2 (vs2 vz2))))

test2 : {g:_}-> {a:_} -> Tm2 g (arr2 (arr2 a a) (arr2 a a))
test2  = lam2 (lam2 (app2 v12 (app2 v12 (app2 v12 (app2 v12 (app2 v12 (app2 v12 v02)))))))
Ty3 : Type
Ty3 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty3 : Ty3
empty3 = \ _, empty, _ => empty

arr3 : Ty3 -> Ty3 -> Ty3
arr3 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con3 : Type
Con3 = (Con3 : Type)
 ->(nil  : Con3)
 ->(snoc : Con3 -> Ty3 -> Con3)
 -> Con3

nil3 : Con3
nil3 = \ con, nil3, snoc => nil3

snoc3 : Con3 -> Ty3 -> Con3
snoc3 = \ g, a, con, nil3, snoc3 => snoc3 (g con nil3 snoc3) a

Var3 : Con3 -> Ty3 -> Type
Var3 = \ g, a =>
    (Var3 : Con3 -> Ty3 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var3 (snoc3 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var3 g a -> Var3 (snoc3 g b) a)
 -> Var3 g a

vz3 : {g : _}-> {a : _} -> Var3 (snoc3 g a) a
vz3 = \ var, vz3, vs => vz3 _ _

vs3 : {g : _} -> {B : _} -> {a : _} -> Var3 g a -> Var3 (snoc3 g B) a
vs3 = \ x, var, vz3, vs3 => vs3 _ _ _ (x var vz3 vs3)

Tm3 : Con3 -> Ty3 -> Type
Tm3 = \ g, a =>
    (Tm3    : Con3 -> Ty3 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var3 g a -> Tm3 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm3 (snoc3 g a) B -> Tm3 g (arr3 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm3 g (arr3 a B) -> Tm3 g a -> Tm3 g B)
 -> Tm3 g a

var3 : {g : _} -> {a : _} -> Var3 g a -> Tm3 g a
var3 = \ x, tm, var3, lam, app => var3 _ _ x

lam3 : {g : _} -> {a : _} -> {B : _} -> Tm3 (snoc3 g a) B -> Tm3 g (arr3 a B)
lam3 = \ t, tm, var3, lam3, app => lam3 _ _ _ (t tm var3 lam3 app)

app3 : {g:_}->{a:_}->{B:_} -> Tm3 g (arr3 a B) -> Tm3 g a -> Tm3 g B
app3 = \ t, u, tm, var3, lam3, app3 => app3 _ _ _ (t tm var3 lam3 app3) (u tm var3 lam3 app3)

v03 : {g:_}->{a:_} -> Tm3 (snoc3 g a) a
v03 = var3 vz3

v13 : {g:_}->{a:_}-> {B:_}-> Tm3 (snoc3 (snoc3 g a) B) a
v13 = var3 (vs3 vz3)

v23 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm3 (snoc3 (snoc3 (snoc3 g a) B) C) a
v23 = var3 (vs3 (vs3 vz3))

v33 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm3 (snoc3 (snoc3 (snoc3 (snoc3 g a) B) C) D) a
v33 = var3 (vs3 (vs3 (vs3 vz3)))

v43 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm3 (snoc3 (snoc3 (snoc3 (snoc3 (snoc3 g a) B) C) D) E) a
v43 = var3 (vs3 (vs3 (vs3 (vs3 vz3))))

test3 : {g:_}-> {a:_} -> Tm3 g (arr3 (arr3 a a) (arr3 a a))
test3  = lam3 (lam3 (app3 v13 (app3 v13 (app3 v13 (app3 v13 (app3 v13 (app3 v13 v03)))))))
Ty4 : Type
Ty4 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty4 : Ty4
empty4 = \ _, empty, _ => empty

arr4 : Ty4 -> Ty4 -> Ty4
arr4 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con4 : Type
Con4 = (Con4 : Type)
 ->(nil  : Con4)
 ->(snoc : Con4 -> Ty4 -> Con4)
 -> Con4

nil4 : Con4
nil4 = \ con, nil4, snoc => nil4

snoc4 : Con4 -> Ty4 -> Con4
snoc4 = \ g, a, con, nil4, snoc4 => snoc4 (g con nil4 snoc4) a

Var4 : Con4 -> Ty4 -> Type
Var4 = \ g, a =>
    (Var4 : Con4 -> Ty4 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var4 (snoc4 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var4 g a -> Var4 (snoc4 g b) a)
 -> Var4 g a

vz4 : {g : _}-> {a : _} -> Var4 (snoc4 g a) a
vz4 = \ var, vz4, vs => vz4 _ _

vs4 : {g : _} -> {B : _} -> {a : _} -> Var4 g a -> Var4 (snoc4 g B) a
vs4 = \ x, var, vz4, vs4 => vs4 _ _ _ (x var vz4 vs4)

Tm4 : Con4 -> Ty4 -> Type
Tm4 = \ g, a =>
    (Tm4    : Con4 -> Ty4 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var4 g a -> Tm4 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm4 (snoc4 g a) B -> Tm4 g (arr4 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm4 g (arr4 a B) -> Tm4 g a -> Tm4 g B)
 -> Tm4 g a

var4 : {g : _} -> {a : _} -> Var4 g a -> Tm4 g a
var4 = \ x, tm, var4, lam, app => var4 _ _ x

lam4 : {g : _} -> {a : _} -> {B : _} -> Tm4 (snoc4 g a) B -> Tm4 g (arr4 a B)
lam4 = \ t, tm, var4, lam4, app => lam4 _ _ _ (t tm var4 lam4 app)

app4 : {g:_}->{a:_}->{B:_} -> Tm4 g (arr4 a B) -> Tm4 g a -> Tm4 g B
app4 = \ t, u, tm, var4, lam4, app4 => app4 _ _ _ (t tm var4 lam4 app4) (u tm var4 lam4 app4)

v04 : {g:_}->{a:_} -> Tm4 (snoc4 g a) a
v04 = var4 vz4

v14 : {g:_}->{a:_}-> {B:_}-> Tm4 (snoc4 (snoc4 g a) B) a
v14 = var4 (vs4 vz4)

v24 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm4 (snoc4 (snoc4 (snoc4 g a) B) C) a
v24 = var4 (vs4 (vs4 vz4))

v34 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm4 (snoc4 (snoc4 (snoc4 (snoc4 g a) B) C) D) a
v34 = var4 (vs4 (vs4 (vs4 vz4)))

v44 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm4 (snoc4 (snoc4 (snoc4 (snoc4 (snoc4 g a) B) C) D) E) a
v44 = var4 (vs4 (vs4 (vs4 (vs4 vz4))))

test4 : {g:_}-> {a:_} -> Tm4 g (arr4 (arr4 a a) (arr4 a a))
test4  = lam4 (lam4 (app4 v14 (app4 v14 (app4 v14 (app4 v14 (app4 v14 (app4 v14 v04)))))))
Ty5 : Type
Ty5 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty5 : Ty5
empty5 = \ _, empty, _ => empty

arr5 : Ty5 -> Ty5 -> Ty5
arr5 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con5 : Type
Con5 = (Con5 : Type)
 ->(nil  : Con5)
 ->(snoc : Con5 -> Ty5 -> Con5)
 -> Con5

nil5 : Con5
nil5 = \ con, nil5, snoc => nil5

snoc5 : Con5 -> Ty5 -> Con5
snoc5 = \ g, a, con, nil5, snoc5 => snoc5 (g con nil5 snoc5) a

Var5 : Con5 -> Ty5 -> Type
Var5 = \ g, a =>
    (Var5 : Con5 -> Ty5 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var5 (snoc5 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var5 g a -> Var5 (snoc5 g b) a)
 -> Var5 g a

vz5 : {g : _}-> {a : _} -> Var5 (snoc5 g a) a
vz5 = \ var, vz5, vs => vz5 _ _

vs5 : {g : _} -> {B : _} -> {a : _} -> Var5 g a -> Var5 (snoc5 g B) a
vs5 = \ x, var, vz5, vs5 => vs5 _ _ _ (x var vz5 vs5)

Tm5 : Con5 -> Ty5 -> Type
Tm5 = \ g, a =>
    (Tm5    : Con5 -> Ty5 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var5 g a -> Tm5 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm5 (snoc5 g a) B -> Tm5 g (arr5 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm5 g (arr5 a B) -> Tm5 g a -> Tm5 g B)
 -> Tm5 g a

var5 : {g : _} -> {a : _} -> Var5 g a -> Tm5 g a
var5 = \ x, tm, var5, lam, app => var5 _ _ x

lam5 : {g : _} -> {a : _} -> {B : _} -> Tm5 (snoc5 g a) B -> Tm5 g (arr5 a B)
lam5 = \ t, tm, var5, lam5, app => lam5 _ _ _ (t tm var5 lam5 app)

app5 : {g:_}->{a:_}->{B:_} -> Tm5 g (arr5 a B) -> Tm5 g a -> Tm5 g B
app5 = \ t, u, tm, var5, lam5, app5 => app5 _ _ _ (t tm var5 lam5 app5) (u tm var5 lam5 app5)

v05 : {g:_}->{a:_} -> Tm5 (snoc5 g a) a
v05 = var5 vz5

v15 : {g:_}->{a:_}-> {B:_}-> Tm5 (snoc5 (snoc5 g a) B) a
v15 = var5 (vs5 vz5)

v25 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm5 (snoc5 (snoc5 (snoc5 g a) B) C) a
v25 = var5 (vs5 (vs5 vz5))

v35 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm5 (snoc5 (snoc5 (snoc5 (snoc5 g a) B) C) D) a
v35 = var5 (vs5 (vs5 (vs5 vz5)))

v45 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm5 (snoc5 (snoc5 (snoc5 (snoc5 (snoc5 g a) B) C) D) E) a
v45 = var5 (vs5 (vs5 (vs5 (vs5 vz5))))

test5 : {g:_}-> {a:_} -> Tm5 g (arr5 (arr5 a a) (arr5 a a))
test5  = lam5 (lam5 (app5 v15 (app5 v15 (app5 v15 (app5 v15 (app5 v15 (app5 v15 v05)))))))
Ty6 : Type
Ty6 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty6 : Ty6
empty6 = \ _, empty, _ => empty

arr6 : Ty6 -> Ty6 -> Ty6
arr6 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con6 : Type
Con6 = (Con6 : Type)
 ->(nil  : Con6)
 ->(snoc : Con6 -> Ty6 -> Con6)
 -> Con6

nil6 : Con6
nil6 = \ con, nil6, snoc => nil6

snoc6 : Con6 -> Ty6 -> Con6
snoc6 = \ g, a, con, nil6, snoc6 => snoc6 (g con nil6 snoc6) a

Var6 : Con6 -> Ty6 -> Type
Var6 = \ g, a =>
    (Var6 : Con6 -> Ty6 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var6 (snoc6 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var6 g a -> Var6 (snoc6 g b) a)
 -> Var6 g a

vz6 : {g : _}-> {a : _} -> Var6 (snoc6 g a) a
vz6 = \ var, vz6, vs => vz6 _ _

vs6 : {g : _} -> {B : _} -> {a : _} -> Var6 g a -> Var6 (snoc6 g B) a
vs6 = \ x, var, vz6, vs6 => vs6 _ _ _ (x var vz6 vs6)

Tm6 : Con6 -> Ty6 -> Type
Tm6 = \ g, a =>
    (Tm6    : Con6 -> Ty6 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var6 g a -> Tm6 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm6 (snoc6 g a) B -> Tm6 g (arr6 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm6 g (arr6 a B) -> Tm6 g a -> Tm6 g B)
 -> Tm6 g a

var6 : {g : _} -> {a : _} -> Var6 g a -> Tm6 g a
var6 = \ x, tm, var6, lam, app => var6 _ _ x

lam6 : {g : _} -> {a : _} -> {B : _} -> Tm6 (snoc6 g a) B -> Tm6 g (arr6 a B)
lam6 = \ t, tm, var6, lam6, app => lam6 _ _ _ (t tm var6 lam6 app)

app6 : {g:_}->{a:_}->{B:_} -> Tm6 g (arr6 a B) -> Tm6 g a -> Tm6 g B
app6 = \ t, u, tm, var6, lam6, app6 => app6 _ _ _ (t tm var6 lam6 app6) (u tm var6 lam6 app6)

v06 : {g:_}->{a:_} -> Tm6 (snoc6 g a) a
v06 = var6 vz6

v16 : {g:_}->{a:_}-> {B:_}-> Tm6 (snoc6 (snoc6 g a) B) a
v16 = var6 (vs6 vz6)

v26 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm6 (snoc6 (snoc6 (snoc6 g a) B) C) a
v26 = var6 (vs6 (vs6 vz6))

v36 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm6 (snoc6 (snoc6 (snoc6 (snoc6 g a) B) C) D) a
v36 = var6 (vs6 (vs6 (vs6 vz6)))

v46 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm6 (snoc6 (snoc6 (snoc6 (snoc6 (snoc6 g a) B) C) D) E) a
v46 = var6 (vs6 (vs6 (vs6 (vs6 vz6))))

test6 : {g:_}-> {a:_} -> Tm6 g (arr6 (arr6 a a) (arr6 a a))
test6  = lam6 (lam6 (app6 v16 (app6 v16 (app6 v16 (app6 v16 (app6 v16 (app6 v16 v06)))))))
Ty7 : Type
Ty7 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty7 : Ty7
empty7 = \ _, empty, _ => empty

arr7 : Ty7 -> Ty7 -> Ty7
arr7 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con7 : Type
Con7 = (Con7 : Type)
 ->(nil  : Con7)
 ->(snoc : Con7 -> Ty7 -> Con7)
 -> Con7

nil7 : Con7
nil7 = \ con, nil7, snoc => nil7

snoc7 : Con7 -> Ty7 -> Con7
snoc7 = \ g, a, con, nil7, snoc7 => snoc7 (g con nil7 snoc7) a

Var7 : Con7 -> Ty7 -> Type
Var7 = \ g, a =>
    (Var7 : Con7 -> Ty7 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var7 (snoc7 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var7 g a -> Var7 (snoc7 g b) a)
 -> Var7 g a

vz7 : {g : _}-> {a : _} -> Var7 (snoc7 g a) a
vz7 = \ var, vz7, vs => vz7 _ _

vs7 : {g : _} -> {B : _} -> {a : _} -> Var7 g a -> Var7 (snoc7 g B) a
vs7 = \ x, var, vz7, vs7 => vs7 _ _ _ (x var vz7 vs7)

Tm7 : Con7 -> Ty7 -> Type
Tm7 = \ g, a =>
    (Tm7    : Con7 -> Ty7 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var7 g a -> Tm7 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm7 (snoc7 g a) B -> Tm7 g (arr7 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm7 g (arr7 a B) -> Tm7 g a -> Tm7 g B)
 -> Tm7 g a

var7 : {g : _} -> {a : _} -> Var7 g a -> Tm7 g a
var7 = \ x, tm, var7, lam, app => var7 _ _ x

lam7 : {g : _} -> {a : _} -> {B : _} -> Tm7 (snoc7 g a) B -> Tm7 g (arr7 a B)
lam7 = \ t, tm, var7, lam7, app => lam7 _ _ _ (t tm var7 lam7 app)

app7 : {g:_}->{a:_}->{B:_} -> Tm7 g (arr7 a B) -> Tm7 g a -> Tm7 g B
app7 = \ t, u, tm, var7, lam7, app7 => app7 _ _ _ (t tm var7 lam7 app7) (u tm var7 lam7 app7)

v07 : {g:_}->{a:_} -> Tm7 (snoc7 g a) a
v07 = var7 vz7

v17 : {g:_}->{a:_}-> {B:_}-> Tm7 (snoc7 (snoc7 g a) B) a
v17 = var7 (vs7 vz7)

v27 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm7 (snoc7 (snoc7 (snoc7 g a) B) C) a
v27 = var7 (vs7 (vs7 vz7))

v37 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm7 (snoc7 (snoc7 (snoc7 (snoc7 g a) B) C) D) a
v37 = var7 (vs7 (vs7 (vs7 vz7)))

v47 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm7 (snoc7 (snoc7 (snoc7 (snoc7 (snoc7 g a) B) C) D) E) a
v47 = var7 (vs7 (vs7 (vs7 (vs7 vz7))))

test7 : {g:_}-> {a:_} -> Tm7 g (arr7 (arr7 a a) (arr7 a a))
test7  = lam7 (lam7 (app7 v17 (app7 v17 (app7 v17 (app7 v17 (app7 v17 (app7 v17 v07)))))))
Ty8 : Type
Ty8 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty8 : Ty8
empty8 = \ _, empty, _ => empty

arr8 : Ty8 -> Ty8 -> Ty8
arr8 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con8 : Type
Con8 = (Con8 : Type)
 ->(nil  : Con8)
 ->(snoc : Con8 -> Ty8 -> Con8)
 -> Con8

nil8 : Con8
nil8 = \ con, nil8, snoc => nil8

snoc8 : Con8 -> Ty8 -> Con8
snoc8 = \ g, a, con, nil8, snoc8 => snoc8 (g con nil8 snoc8) a

Var8 : Con8 -> Ty8 -> Type
Var8 = \ g, a =>
    (Var8 : Con8 -> Ty8 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var8 (snoc8 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var8 g a -> Var8 (snoc8 g b) a)
 -> Var8 g a

vz8 : {g : _}-> {a : _} -> Var8 (snoc8 g a) a
vz8 = \ var, vz8, vs => vz8 _ _

vs8 : {g : _} -> {B : _} -> {a : _} -> Var8 g a -> Var8 (snoc8 g B) a
vs8 = \ x, var, vz8, vs8 => vs8 _ _ _ (x var vz8 vs8)

Tm8 : Con8 -> Ty8 -> Type
Tm8 = \ g, a =>
    (Tm8    : Con8 -> Ty8 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var8 g a -> Tm8 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm8 (snoc8 g a) B -> Tm8 g (arr8 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm8 g (arr8 a B) -> Tm8 g a -> Tm8 g B)
 -> Tm8 g a

var8 : {g : _} -> {a : _} -> Var8 g a -> Tm8 g a
var8 = \ x, tm, var8, lam, app => var8 _ _ x

lam8 : {g : _} -> {a : _} -> {B : _} -> Tm8 (snoc8 g a) B -> Tm8 g (arr8 a B)
lam8 = \ t, tm, var8, lam8, app => lam8 _ _ _ (t tm var8 lam8 app)

app8 : {g:_}->{a:_}->{B:_} -> Tm8 g (arr8 a B) -> Tm8 g a -> Tm8 g B
app8 = \ t, u, tm, var8, lam8, app8 => app8 _ _ _ (t tm var8 lam8 app8) (u tm var8 lam8 app8)

v08 : {g:_}->{a:_} -> Tm8 (snoc8 g a) a
v08 = var8 vz8

v18 : {g:_}->{a:_}-> {B:_}-> Tm8 (snoc8 (snoc8 g a) B) a
v18 = var8 (vs8 vz8)

v28 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm8 (snoc8 (snoc8 (snoc8 g a) B) C) a
v28 = var8 (vs8 (vs8 vz8))

v38 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm8 (snoc8 (snoc8 (snoc8 (snoc8 g a) B) C) D) a
v38 = var8 (vs8 (vs8 (vs8 vz8)))

v48 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm8 (snoc8 (snoc8 (snoc8 (snoc8 (snoc8 g a) B) C) D) E) a
v48 = var8 (vs8 (vs8 (vs8 (vs8 vz8))))

test8 : {g:_}-> {a:_} -> Tm8 g (arr8 (arr8 a a) (arr8 a a))
test8  = lam8 (lam8 (app8 v18 (app8 v18 (app8 v18 (app8 v18 (app8 v18 (app8 v18 v08)))))))
Ty9 : Type
Ty9 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty9 : Ty9
empty9 = \ _, empty, _ => empty

arr9 : Ty9 -> Ty9 -> Ty9
arr9 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con9 : Type
Con9 = (Con9 : Type)
 ->(nil  : Con9)
 ->(snoc : Con9 -> Ty9 -> Con9)
 -> Con9

nil9 : Con9
nil9 = \ con, nil9, snoc => nil9

snoc9 : Con9 -> Ty9 -> Con9
snoc9 = \ g, a, con, nil9, snoc9 => snoc9 (g con nil9 snoc9) a

Var9 : Con9 -> Ty9 -> Type
Var9 = \ g, a =>
    (Var9 : Con9 -> Ty9 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var9 (snoc9 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var9 g a -> Var9 (snoc9 g b) a)
 -> Var9 g a

vz9 : {g : _}-> {a : _} -> Var9 (snoc9 g a) a
vz9 = \ var, vz9, vs => vz9 _ _

vs9 : {g : _} -> {B : _} -> {a : _} -> Var9 g a -> Var9 (snoc9 g B) a
vs9 = \ x, var, vz9, vs9 => vs9 _ _ _ (x var vz9 vs9)

Tm9 : Con9 -> Ty9 -> Type
Tm9 = \ g, a =>
    (Tm9    : Con9 -> Ty9 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var9 g a -> Tm9 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm9 (snoc9 g a) B -> Tm9 g (arr9 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm9 g (arr9 a B) -> Tm9 g a -> Tm9 g B)
 -> Tm9 g a

var9 : {g : _} -> {a : _} -> Var9 g a -> Tm9 g a
var9 = \ x, tm, var9, lam, app => var9 _ _ x

lam9 : {g : _} -> {a : _} -> {B : _} -> Tm9 (snoc9 g a) B -> Tm9 g (arr9 a B)
lam9 = \ t, tm, var9, lam9, app => lam9 _ _ _ (t tm var9 lam9 app)

app9 : {g:_}->{a:_}->{B:_} -> Tm9 g (arr9 a B) -> Tm9 g a -> Tm9 g B
app9 = \ t, u, tm, var9, lam9, app9 => app9 _ _ _ (t tm var9 lam9 app9) (u tm var9 lam9 app9)

v09 : {g:_}->{a:_} -> Tm9 (snoc9 g a) a
v09 = var9 vz9

v19 : {g:_}->{a:_}-> {B:_}-> Tm9 (snoc9 (snoc9 g a) B) a
v19 = var9 (vs9 vz9)

v29 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm9 (snoc9 (snoc9 (snoc9 g a) B) C) a
v29 = var9 (vs9 (vs9 vz9))

v39 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm9 (snoc9 (snoc9 (snoc9 (snoc9 g a) B) C) D) a
v39 = var9 (vs9 (vs9 (vs9 vz9)))

v49 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm9 (snoc9 (snoc9 (snoc9 (snoc9 (snoc9 g a) B) C) D) E) a
v49 = var9 (vs9 (vs9 (vs9 (vs9 vz9))))

test9 : {g:_}-> {a:_} -> Tm9 g (arr9 (arr9 a a) (arr9 a a))
test9  = lam9 (lam9 (app9 v19 (app9 v19 (app9 v19 (app9 v19 (app9 v19 (app9 v19 v09)))))))
Ty10 : Type
Ty10 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty10 : Ty10
empty10 = \ _, empty, _ => empty

arr10 : Ty10 -> Ty10 -> Ty10
arr10 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con10 : Type
Con10 = (Con10 : Type)
 ->(nil  : Con10)
 ->(snoc : Con10 -> Ty10 -> Con10)
 -> Con10

nil10 : Con10
nil10 = \ con, nil10, snoc => nil10

snoc10 : Con10 -> Ty10 -> Con10
snoc10 = \ g, a, con, nil10, snoc10 => snoc10 (g con nil10 snoc10) a

Var10 : Con10 -> Ty10 -> Type
Var10 = \ g, a =>
    (Var10 : Con10 -> Ty10 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var10 (snoc10 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var10 g a -> Var10 (snoc10 g b) a)
 -> Var10 g a

vz10 : {g : _}-> {a : _} -> Var10 (snoc10 g a) a
vz10 = \ var, vz10, vs => vz10 _ _

vs10 : {g : _} -> {B : _} -> {a : _} -> Var10 g a -> Var10 (snoc10 g B) a
vs10 = \ x, var, vz10, vs10 => vs10 _ _ _ (x var vz10 vs10)

Tm10 : Con10 -> Ty10 -> Type
Tm10 = \ g, a =>
    (Tm10    : Con10 -> Ty10 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var10 g a -> Tm10 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm10 (snoc10 g a) B -> Tm10 g (arr10 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm10 g (arr10 a B) -> Tm10 g a -> Tm10 g B)
 -> Tm10 g a

var10 : {g : _} -> {a : _} -> Var10 g a -> Tm10 g a
var10 = \ x, tm, var10, lam, app => var10 _ _ x

lam10 : {g : _} -> {a : _} -> {B : _} -> Tm10 (snoc10 g a) B -> Tm10 g (arr10 a B)
lam10 = \ t, tm, var10, lam10, app => lam10 _ _ _ (t tm var10 lam10 app)

app10 : {g:_}->{a:_}->{B:_} -> Tm10 g (arr10 a B) -> Tm10 g a -> Tm10 g B
app10 = \ t, u, tm, var10, lam10, app10 => app10 _ _ _ (t tm var10 lam10 app10) (u tm var10 lam10 app10)

v010 : {g:_}->{a:_} -> Tm10 (snoc10 g a) a
v010 = var10 vz10

v110 : {g:_}->{a:_}-> {B:_}-> Tm10 (snoc10 (snoc10 g a) B) a
v110 = var10 (vs10 vz10)

v210 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm10 (snoc10 (snoc10 (snoc10 g a) B) C) a
v210 = var10 (vs10 (vs10 vz10))

v310 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm10 (snoc10 (snoc10 (snoc10 (snoc10 g a) B) C) D) a
v310 = var10 (vs10 (vs10 (vs10 vz10)))

v410 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm10 (snoc10 (snoc10 (snoc10 (snoc10 (snoc10 g a) B) C) D) E) a
v410 = var10 (vs10 (vs10 (vs10 (vs10 vz10))))

test10 : {g:_}-> {a:_} -> Tm10 g (arr10 (arr10 a a) (arr10 a a))
test10  = lam10 (lam10 (app10 v110 (app10 v110 (app10 v110 (app10 v110 (app10 v110 (app10 v110 v010)))))))
Ty11 : Type
Ty11 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty11 : Ty11
empty11 = \ _, empty, _ => empty

arr11 : Ty11 -> Ty11 -> Ty11
arr11 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con11 : Type
Con11 = (Con11 : Type)
 ->(nil  : Con11)
 ->(snoc : Con11 -> Ty11 -> Con11)
 -> Con11

nil11 : Con11
nil11 = \ con, nil11, snoc => nil11

snoc11 : Con11 -> Ty11 -> Con11
snoc11 = \ g, a, con, nil11, snoc11 => snoc11 (g con nil11 snoc11) a

Var11 : Con11 -> Ty11 -> Type
Var11 = \ g, a =>
    (Var11 : Con11 -> Ty11 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var11 (snoc11 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var11 g a -> Var11 (snoc11 g b) a)
 -> Var11 g a

vz11 : {g : _}-> {a : _} -> Var11 (snoc11 g a) a
vz11 = \ var, vz11, vs => vz11 _ _

vs11 : {g : _} -> {B : _} -> {a : _} -> Var11 g a -> Var11 (snoc11 g B) a
vs11 = \ x, var, vz11, vs11 => vs11 _ _ _ (x var vz11 vs11)

Tm11 : Con11 -> Ty11 -> Type
Tm11 = \ g, a =>
    (Tm11    : Con11 -> Ty11 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var11 g a -> Tm11 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm11 (snoc11 g a) B -> Tm11 g (arr11 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm11 g (arr11 a B) -> Tm11 g a -> Tm11 g B)
 -> Tm11 g a

var11 : {g : _} -> {a : _} -> Var11 g a -> Tm11 g a
var11 = \ x, tm, var11, lam, app => var11 _ _ x

lam11 : {g : _} -> {a : _} -> {B : _} -> Tm11 (snoc11 g a) B -> Tm11 g (arr11 a B)
lam11 = \ t, tm, var11, lam11, app => lam11 _ _ _ (t tm var11 lam11 app)

app11 : {g:_}->{a:_}->{B:_} -> Tm11 g (arr11 a B) -> Tm11 g a -> Tm11 g B
app11 = \ t, u, tm, var11, lam11, app11 => app11 _ _ _ (t tm var11 lam11 app11) (u tm var11 lam11 app11)

v011 : {g:_}->{a:_} -> Tm11 (snoc11 g a) a
v011 = var11 vz11

v111 : {g:_}->{a:_}-> {B:_}-> Tm11 (snoc11 (snoc11 g a) B) a
v111 = var11 (vs11 vz11)

v211 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm11 (snoc11 (snoc11 (snoc11 g a) B) C) a
v211 = var11 (vs11 (vs11 vz11))

v311 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm11 (snoc11 (snoc11 (snoc11 (snoc11 g a) B) C) D) a
v311 = var11 (vs11 (vs11 (vs11 vz11)))

v411 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm11 (snoc11 (snoc11 (snoc11 (snoc11 (snoc11 g a) B) C) D) E) a
v411 = var11 (vs11 (vs11 (vs11 (vs11 vz11))))

test11 : {g:_}-> {a:_} -> Tm11 g (arr11 (arr11 a a) (arr11 a a))
test11  = lam11 (lam11 (app11 v111 (app11 v111 (app11 v111 (app11 v111 (app11 v111 (app11 v111 v011)))))))
Ty12 : Type
Ty12 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty12 : Ty12
empty12 = \ _, empty, _ => empty

arr12 : Ty12 -> Ty12 -> Ty12
arr12 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con12 : Type
Con12 = (Con12 : Type)
 ->(nil  : Con12)
 ->(snoc : Con12 -> Ty12 -> Con12)
 -> Con12

nil12 : Con12
nil12 = \ con, nil12, snoc => nil12

snoc12 : Con12 -> Ty12 -> Con12
snoc12 = \ g, a, con, nil12, snoc12 => snoc12 (g con nil12 snoc12) a

Var12 : Con12 -> Ty12 -> Type
Var12 = \ g, a =>
    (Var12 : Con12 -> Ty12 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var12 (snoc12 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var12 g a -> Var12 (snoc12 g b) a)
 -> Var12 g a

vz12 : {g : _}-> {a : _} -> Var12 (snoc12 g a) a
vz12 = \ var, vz12, vs => vz12 _ _

vs12 : {g : _} -> {B : _} -> {a : _} -> Var12 g a -> Var12 (snoc12 g B) a
vs12 = \ x, var, vz12, vs12 => vs12 _ _ _ (x var vz12 vs12)

Tm12 : Con12 -> Ty12 -> Type
Tm12 = \ g, a =>
    (Tm12    : Con12 -> Ty12 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var12 g a -> Tm12 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm12 (snoc12 g a) B -> Tm12 g (arr12 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm12 g (arr12 a B) -> Tm12 g a -> Tm12 g B)
 -> Tm12 g a

var12 : {g : _} -> {a : _} -> Var12 g a -> Tm12 g a
var12 = \ x, tm, var12, lam, app => var12 _ _ x

lam12 : {g : _} -> {a : _} -> {B : _} -> Tm12 (snoc12 g a) B -> Tm12 g (arr12 a B)
lam12 = \ t, tm, var12, lam12, app => lam12 _ _ _ (t tm var12 lam12 app)

app12 : {g:_}->{a:_}->{B:_} -> Tm12 g (arr12 a B) -> Tm12 g a -> Tm12 g B
app12 = \ t, u, tm, var12, lam12, app12 => app12 _ _ _ (t tm var12 lam12 app12) (u tm var12 lam12 app12)

v012 : {g:_}->{a:_} -> Tm12 (snoc12 g a) a
v012 = var12 vz12

v112 : {g:_}->{a:_}-> {B:_}-> Tm12 (snoc12 (snoc12 g a) B) a
v112 = var12 (vs12 vz12)

v212 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm12 (snoc12 (snoc12 (snoc12 g a) B) C) a
v212 = var12 (vs12 (vs12 vz12))

v312 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm12 (snoc12 (snoc12 (snoc12 (snoc12 g a) B) C) D) a
v312 = var12 (vs12 (vs12 (vs12 vz12)))

v412 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm12 (snoc12 (snoc12 (snoc12 (snoc12 (snoc12 g a) B) C) D) E) a
v412 = var12 (vs12 (vs12 (vs12 (vs12 vz12))))

test12 : {g:_}-> {a:_} -> Tm12 g (arr12 (arr12 a a) (arr12 a a))
test12  = lam12 (lam12 (app12 v112 (app12 v112 (app12 v112 (app12 v112 (app12 v112 (app12 v112 v012)))))))
Ty13 : Type
Ty13 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty13 : Ty13
empty13 = \ _, empty, _ => empty

arr13 : Ty13 -> Ty13 -> Ty13
arr13 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con13 : Type
Con13 = (Con13 : Type)
 ->(nil  : Con13)
 ->(snoc : Con13 -> Ty13 -> Con13)
 -> Con13

nil13 : Con13
nil13 = \ con, nil13, snoc => nil13

snoc13 : Con13 -> Ty13 -> Con13
snoc13 = \ g, a, con, nil13, snoc13 => snoc13 (g con nil13 snoc13) a

Var13 : Con13 -> Ty13 -> Type
Var13 = \ g, a =>
    (Var13 : Con13 -> Ty13 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var13 (snoc13 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var13 g a -> Var13 (snoc13 g b) a)
 -> Var13 g a

vz13 : {g : _}-> {a : _} -> Var13 (snoc13 g a) a
vz13 = \ var, vz13, vs => vz13 _ _

vs13 : {g : _} -> {B : _} -> {a : _} -> Var13 g a -> Var13 (snoc13 g B) a
vs13 = \ x, var, vz13, vs13 => vs13 _ _ _ (x var vz13 vs13)

Tm13 : Con13 -> Ty13 -> Type
Tm13 = \ g, a =>
    (Tm13    : Con13 -> Ty13 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var13 g a -> Tm13 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm13 (snoc13 g a) B -> Tm13 g (arr13 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm13 g (arr13 a B) -> Tm13 g a -> Tm13 g B)
 -> Tm13 g a

var13 : {g : _} -> {a : _} -> Var13 g a -> Tm13 g a
var13 = \ x, tm, var13, lam, app => var13 _ _ x

lam13 : {g : _} -> {a : _} -> {B : _} -> Tm13 (snoc13 g a) B -> Tm13 g (arr13 a B)
lam13 = \ t, tm, var13, lam13, app => lam13 _ _ _ (t tm var13 lam13 app)

app13 : {g:_}->{a:_}->{B:_} -> Tm13 g (arr13 a B) -> Tm13 g a -> Tm13 g B
app13 = \ t, u, tm, var13, lam13, app13 => app13 _ _ _ (t tm var13 lam13 app13) (u tm var13 lam13 app13)

v013 : {g:_}->{a:_} -> Tm13 (snoc13 g a) a
v013 = var13 vz13

v113 : {g:_}->{a:_}-> {B:_}-> Tm13 (snoc13 (snoc13 g a) B) a
v113 = var13 (vs13 vz13)

v213 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm13 (snoc13 (snoc13 (snoc13 g a) B) C) a
v213 = var13 (vs13 (vs13 vz13))

v313 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm13 (snoc13 (snoc13 (snoc13 (snoc13 g a) B) C) D) a
v313 = var13 (vs13 (vs13 (vs13 vz13)))

v413 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm13 (snoc13 (snoc13 (snoc13 (snoc13 (snoc13 g a) B) C) D) E) a
v413 = var13 (vs13 (vs13 (vs13 (vs13 vz13))))

test13 : {g:_}-> {a:_} -> Tm13 g (arr13 (arr13 a a) (arr13 a a))
test13  = lam13 (lam13 (app13 v113 (app13 v113 (app13 v113 (app13 v113 (app13 v113 (app13 v113 v013)))))))
Ty14 : Type
Ty14 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty14 : Ty14
empty14 = \ _, empty, _ => empty

arr14 : Ty14 -> Ty14 -> Ty14
arr14 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con14 : Type
Con14 = (Con14 : Type)
 ->(nil  : Con14)
 ->(snoc : Con14 -> Ty14 -> Con14)
 -> Con14

nil14 : Con14
nil14 = \ con, nil14, snoc => nil14

snoc14 : Con14 -> Ty14 -> Con14
snoc14 = \ g, a, con, nil14, snoc14 => snoc14 (g con nil14 snoc14) a

Var14 : Con14 -> Ty14 -> Type
Var14 = \ g, a =>
    (Var14 : Con14 -> Ty14 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var14 (snoc14 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var14 g a -> Var14 (snoc14 g b) a)
 -> Var14 g a

vz14 : {g : _}-> {a : _} -> Var14 (snoc14 g a) a
vz14 = \ var, vz14, vs => vz14 _ _

vs14 : {g : _} -> {B : _} -> {a : _} -> Var14 g a -> Var14 (snoc14 g B) a
vs14 = \ x, var, vz14, vs14 => vs14 _ _ _ (x var vz14 vs14)

Tm14 : Con14 -> Ty14 -> Type
Tm14 = \ g, a =>
    (Tm14    : Con14 -> Ty14 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var14 g a -> Tm14 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm14 (snoc14 g a) B -> Tm14 g (arr14 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm14 g (arr14 a B) -> Tm14 g a -> Tm14 g B)
 -> Tm14 g a

var14 : {g : _} -> {a : _} -> Var14 g a -> Tm14 g a
var14 = \ x, tm, var14, lam, app => var14 _ _ x

lam14 : {g : _} -> {a : _} -> {B : _} -> Tm14 (snoc14 g a) B -> Tm14 g (arr14 a B)
lam14 = \ t, tm, var14, lam14, app => lam14 _ _ _ (t tm var14 lam14 app)

app14 : {g:_}->{a:_}->{B:_} -> Tm14 g (arr14 a B) -> Tm14 g a -> Tm14 g B
app14 = \ t, u, tm, var14, lam14, app14 => app14 _ _ _ (t tm var14 lam14 app14) (u tm var14 lam14 app14)

v014 : {g:_}->{a:_} -> Tm14 (snoc14 g a) a
v014 = var14 vz14

v114 : {g:_}->{a:_}-> {B:_}-> Tm14 (snoc14 (snoc14 g a) B) a
v114 = var14 (vs14 vz14)

v214 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm14 (snoc14 (snoc14 (snoc14 g a) B) C) a
v214 = var14 (vs14 (vs14 vz14))

v314 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm14 (snoc14 (snoc14 (snoc14 (snoc14 g a) B) C) D) a
v314 = var14 (vs14 (vs14 (vs14 vz14)))

v414 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm14 (snoc14 (snoc14 (snoc14 (snoc14 (snoc14 g a) B) C) D) E) a
v414 = var14 (vs14 (vs14 (vs14 (vs14 vz14))))

test14 : {g:_}-> {a:_} -> Tm14 g (arr14 (arr14 a a) (arr14 a a))
test14  = lam14 (lam14 (app14 v114 (app14 v114 (app14 v114 (app14 v114 (app14 v114 (app14 v114 v014)))))))
Ty15 : Type
Ty15 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty15 : Ty15
empty15 = \ _, empty, _ => empty

arr15 : Ty15 -> Ty15 -> Ty15
arr15 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con15 : Type
Con15 = (Con15 : Type)
 ->(nil  : Con15)
 ->(snoc : Con15 -> Ty15 -> Con15)
 -> Con15

nil15 : Con15
nil15 = \ con, nil15, snoc => nil15

snoc15 : Con15 -> Ty15 -> Con15
snoc15 = \ g, a, con, nil15, snoc15 => snoc15 (g con nil15 snoc15) a

Var15 : Con15 -> Ty15 -> Type
Var15 = \ g, a =>
    (Var15 : Con15 -> Ty15 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var15 (snoc15 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var15 g a -> Var15 (snoc15 g b) a)
 -> Var15 g a

vz15 : {g : _}-> {a : _} -> Var15 (snoc15 g a) a
vz15 = \ var, vz15, vs => vz15 _ _

vs15 : {g : _} -> {B : _} -> {a : _} -> Var15 g a -> Var15 (snoc15 g B) a
vs15 = \ x, var, vz15, vs15 => vs15 _ _ _ (x var vz15 vs15)

Tm15 : Con15 -> Ty15 -> Type
Tm15 = \ g, a =>
    (Tm15    : Con15 -> Ty15 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var15 g a -> Tm15 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm15 (snoc15 g a) B -> Tm15 g (arr15 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm15 g (arr15 a B) -> Tm15 g a -> Tm15 g B)
 -> Tm15 g a

var15 : {g : _} -> {a : _} -> Var15 g a -> Tm15 g a
var15 = \ x, tm, var15, lam, app => var15 _ _ x

lam15 : {g : _} -> {a : _} -> {B : _} -> Tm15 (snoc15 g a) B -> Tm15 g (arr15 a B)
lam15 = \ t, tm, var15, lam15, app => lam15 _ _ _ (t tm var15 lam15 app)

app15 : {g:_}->{a:_}->{B:_} -> Tm15 g (arr15 a B) -> Tm15 g a -> Tm15 g B
app15 = \ t, u, tm, var15, lam15, app15 => app15 _ _ _ (t tm var15 lam15 app15) (u tm var15 lam15 app15)

v015 : {g:_}->{a:_} -> Tm15 (snoc15 g a) a
v015 = var15 vz15

v115 : {g:_}->{a:_}-> {B:_}-> Tm15 (snoc15 (snoc15 g a) B) a
v115 = var15 (vs15 vz15)

v215 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm15 (snoc15 (snoc15 (snoc15 g a) B) C) a
v215 = var15 (vs15 (vs15 vz15))

v315 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm15 (snoc15 (snoc15 (snoc15 (snoc15 g a) B) C) D) a
v315 = var15 (vs15 (vs15 (vs15 vz15)))

v415 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm15 (snoc15 (snoc15 (snoc15 (snoc15 (snoc15 g a) B) C) D) E) a
v415 = var15 (vs15 (vs15 (vs15 (vs15 vz15))))

test15 : {g:_}-> {a:_} -> Tm15 g (arr15 (arr15 a a) (arr15 a a))
test15  = lam15 (lam15 (app15 v115 (app15 v115 (app15 v115 (app15 v115 (app15 v115 (app15 v115 v015)))))))
Ty16 : Type
Ty16 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty16 : Ty16
empty16 = \ _, empty, _ => empty

arr16 : Ty16 -> Ty16 -> Ty16
arr16 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con16 : Type
Con16 = (Con16 : Type)
 ->(nil  : Con16)
 ->(snoc : Con16 -> Ty16 -> Con16)
 -> Con16

nil16 : Con16
nil16 = \ con, nil16, snoc => nil16

snoc16 : Con16 -> Ty16 -> Con16
snoc16 = \ g, a, con, nil16, snoc16 => snoc16 (g con nil16 snoc16) a

Var16 : Con16 -> Ty16 -> Type
Var16 = \ g, a =>
    (Var16 : Con16 -> Ty16 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var16 (snoc16 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var16 g a -> Var16 (snoc16 g b) a)
 -> Var16 g a

vz16 : {g : _}-> {a : _} -> Var16 (snoc16 g a) a
vz16 = \ var, vz16, vs => vz16 _ _

vs16 : {g : _} -> {B : _} -> {a : _} -> Var16 g a -> Var16 (snoc16 g B) a
vs16 = \ x, var, vz16, vs16 => vs16 _ _ _ (x var vz16 vs16)

Tm16 : Con16 -> Ty16 -> Type
Tm16 = \ g, a =>
    (Tm16    : Con16 -> Ty16 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var16 g a -> Tm16 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm16 (snoc16 g a) B -> Tm16 g (arr16 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm16 g (arr16 a B) -> Tm16 g a -> Tm16 g B)
 -> Tm16 g a

var16 : {g : _} -> {a : _} -> Var16 g a -> Tm16 g a
var16 = \ x, tm, var16, lam, app => var16 _ _ x

lam16 : {g : _} -> {a : _} -> {B : _} -> Tm16 (snoc16 g a) B -> Tm16 g (arr16 a B)
lam16 = \ t, tm, var16, lam16, app => lam16 _ _ _ (t tm var16 lam16 app)

app16 : {g:_}->{a:_}->{B:_} -> Tm16 g (arr16 a B) -> Tm16 g a -> Tm16 g B
app16 = \ t, u, tm, var16, lam16, app16 => app16 _ _ _ (t tm var16 lam16 app16) (u tm var16 lam16 app16)

v016 : {g:_}->{a:_} -> Tm16 (snoc16 g a) a
v016 = var16 vz16

v116 : {g:_}->{a:_}-> {B:_}-> Tm16 (snoc16 (snoc16 g a) B) a
v116 = var16 (vs16 vz16)

v216 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm16 (snoc16 (snoc16 (snoc16 g a) B) C) a
v216 = var16 (vs16 (vs16 vz16))

v316 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm16 (snoc16 (snoc16 (snoc16 (snoc16 g a) B) C) D) a
v316 = var16 (vs16 (vs16 (vs16 vz16)))

v416 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm16 (snoc16 (snoc16 (snoc16 (snoc16 (snoc16 g a) B) C) D) E) a
v416 = var16 (vs16 (vs16 (vs16 (vs16 vz16))))

test16 : {g:_}-> {a:_} -> Tm16 g (arr16 (arr16 a a) (arr16 a a))
test16  = lam16 (lam16 (app16 v116 (app16 v116 (app16 v116 (app16 v116 (app16 v116 (app16 v116 v016)))))))
Ty17 : Type
Ty17 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty17 : Ty17
empty17 = \ _, empty, _ => empty

arr17 : Ty17 -> Ty17 -> Ty17
arr17 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con17 : Type
Con17 = (Con17 : Type)
 ->(nil  : Con17)
 ->(snoc : Con17 -> Ty17 -> Con17)
 -> Con17

nil17 : Con17
nil17 = \ con, nil17, snoc => nil17

snoc17 : Con17 -> Ty17 -> Con17
snoc17 = \ g, a, con, nil17, snoc17 => snoc17 (g con nil17 snoc17) a

Var17 : Con17 -> Ty17 -> Type
Var17 = \ g, a =>
    (Var17 : Con17 -> Ty17 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var17 (snoc17 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var17 g a -> Var17 (snoc17 g b) a)
 -> Var17 g a

vz17 : {g : _}-> {a : _} -> Var17 (snoc17 g a) a
vz17 = \ var, vz17, vs => vz17 _ _

vs17 : {g : _} -> {B : _} -> {a : _} -> Var17 g a -> Var17 (snoc17 g B) a
vs17 = \ x, var, vz17, vs17 => vs17 _ _ _ (x var vz17 vs17)

Tm17 : Con17 -> Ty17 -> Type
Tm17 = \ g, a =>
    (Tm17    : Con17 -> Ty17 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var17 g a -> Tm17 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm17 (snoc17 g a) B -> Tm17 g (arr17 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm17 g (arr17 a B) -> Tm17 g a -> Tm17 g B)
 -> Tm17 g a

var17 : {g : _} -> {a : _} -> Var17 g a -> Tm17 g a
var17 = \ x, tm, var17, lam, app => var17 _ _ x

lam17 : {g : _} -> {a : _} -> {B : _} -> Tm17 (snoc17 g a) B -> Tm17 g (arr17 a B)
lam17 = \ t, tm, var17, lam17, app => lam17 _ _ _ (t tm var17 lam17 app)

app17 : {g:_}->{a:_}->{B:_} -> Tm17 g (arr17 a B) -> Tm17 g a -> Tm17 g B
app17 = \ t, u, tm, var17, lam17, app17 => app17 _ _ _ (t tm var17 lam17 app17) (u tm var17 lam17 app17)

v017 : {g:_}->{a:_} -> Tm17 (snoc17 g a) a
v017 = var17 vz17

v117 : {g:_}->{a:_}-> {B:_}-> Tm17 (snoc17 (snoc17 g a) B) a
v117 = var17 (vs17 vz17)

v217 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm17 (snoc17 (snoc17 (snoc17 g a) B) C) a
v217 = var17 (vs17 (vs17 vz17))

v317 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm17 (snoc17 (snoc17 (snoc17 (snoc17 g a) B) C) D) a
v317 = var17 (vs17 (vs17 (vs17 vz17)))

v417 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm17 (snoc17 (snoc17 (snoc17 (snoc17 (snoc17 g a) B) C) D) E) a
v417 = var17 (vs17 (vs17 (vs17 (vs17 vz17))))

test17 : {g:_}-> {a:_} -> Tm17 g (arr17 (arr17 a a) (arr17 a a))
test17  = lam17 (lam17 (app17 v117 (app17 v117 (app17 v117 (app17 v117 (app17 v117 (app17 v117 v017)))))))
Ty18 : Type
Ty18 = (Ty    : Type)
   ->(empty : Ty)
   ->(arr   : Ty -> Ty -> Ty)
   -> Ty

empty18 : Ty18
empty18 = \ _, empty, _ => empty

arr18 : Ty18 -> Ty18 -> Ty18
arr18 = \ a, b, ty, empty, arr => arr (a ty empty arr) (b ty empty arr)

Con18 : Type
Con18 = (Con18 : Type)
 ->(nil  : Con18)
 ->(snoc : Con18 -> Ty18 -> Con18)
 -> Con18

nil18 : Con18
nil18 = \ con, nil18, snoc => nil18

snoc18 : Con18 -> Ty18 -> Con18
snoc18 = \ g, a, con, nil18, snoc18 => snoc18 (g con nil18 snoc18) a

Var18 : Con18 -> Ty18 -> Type
Var18 = \ g, a =>
    (Var18 : Con18 -> Ty18 -> Type)
 -> (vz  : (g : _)-> (a : _) -> Var18 (snoc18 g a) a)
 -> (vs  : (g : _)-> (b : _) ->  (a : _) -> Var18 g a -> Var18 (snoc18 g b) a)
 -> Var18 g a

vz18 : {g : _}-> {a : _} -> Var18 (snoc18 g a) a
vz18 = \ var, vz18, vs => vz18 _ _

vs18 : {g : _} -> {B : _} -> {a : _} -> Var18 g a -> Var18 (snoc18 g B) a
vs18 = \ x, var, vz18, vs18 => vs18 _ _ _ (x var vz18 vs18)

Tm18 : Con18 -> Ty18 -> Type
Tm18 = \ g, a =>
    (Tm18    : Con18 -> Ty18 -> Type)
 -> (var   : (g : _) -> (a : _) -> Var18 g a -> Tm18 g a)
 -> (lam   : (g : _) -> (a : _) -> (B : _) -> Tm18 (snoc18 g a) B -> Tm18 g (arr18 a B))
 -> (app   : (g : _) -> (a : _) -> (B : _) -> Tm18 g (arr18 a B) -> Tm18 g a -> Tm18 g B)
 -> Tm18 g a

var18 : {g : _} -> {a : _} -> Var18 g a -> Tm18 g a
var18 = \ x, tm, var18, lam, app => var18 _ _ x

lam18 : {g : _} -> {a : _} -> {B : _} -> Tm18 (snoc18 g a) B -> Tm18 g (arr18 a B)
lam18 = \ t, tm, var18, lam18, app => lam18 _ _ _ (t tm var18 lam18 app)

app18 : {g:_}->{a:_}->{B:_} -> Tm18 g (arr18 a B) -> Tm18 g a -> Tm18 g B
app18 = \ t, u, tm, var18, lam18, app18 => app18 _ _ _ (t tm var18 lam18 app18) (u tm var18 lam18 app18)

v018 : {g:_}->{a:_} -> Tm18 (snoc18 g a) a
v018 = var18 vz18

v118 : {g:_}->{a:_}-> {B:_}-> Tm18 (snoc18 (snoc18 g a) B) a
v118 = var18 (vs18 vz18)

v218 : {g:_}-> {a:_}-> {B:_}-> {C:_} -> Tm18 (snoc18 (snoc18 (snoc18 g a) B) C) a
v218 = var18 (vs18 (vs18 vz18))

v318 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_} -> Tm18 (snoc18 (snoc18 (snoc18 (snoc18 g a) B) C) D) a
v318 = var18 (vs18 (vs18 (vs18 vz18)))

v418 : {g:_}-> {a:_}-> {B:_}-> {C:_}-> {D:_}-> {E:_}-> Tm18 (snoc18 (snoc18 (snoc18 (snoc18 (snoc18 g a) B) C) D) E) a
v418 = var18 (vs18 (vs18 (vs18 (vs18 vz18))))

test18 : {g:_}-> {a:_} -> Tm18 g (arr18 (arr18 a a) (arr18 a a))
test18  = lam18 (lam18 (app18 v118 (app18 v118 (app18 v118 (app18 v118 (app18 v118 (app18 v118 v018)))))))


record Is3 (n : Nat) where
  constructor MkThree
  {auto prf : n === 3}

three : Is3 3
three = MkThree


module Main

import FndType

-- Lifted increment function. Input fund must be at least 1.
inc : (FndType (10 + fund) Int) -> (FndType fund Int)
-- inc = upliftFun (\x => (x + 1))
inc (FT i) = FT (i + 1)

-- Lifted decrement function. Input fund must be at least 1.
dec : (FndType (10 + fund) Int) -> (FndType fund Int)
-- dec = upliftFun (\x => (x - 1))
dec (FT i) = FT (i - 1)

-- Main
rich_42 : FndType 99 Int
rich_42 = FT 42
poor_42 : FndType 1 Int
poor_42 = FT 42
main : IO ()
main = do
  putStrLn (FndType.show rich_42)
  putStrLn (FndType.show (inc rich_42)) -- Decrement the fund while incrementing the content
  -- putStrLn (FndType.show (inc poor_42)) -- Just enough fund
  -- putStrLn (FndType.show ((compose inc dec) rich_42)) -- Decrement the fund by 2
  -- putStrLn (show ((compose inc dec) poor_42)) -- Not enough fund


module Minesweeper.Board

import Data.Vect
import Data.Fin

import Effects
import Effect.Random
import Effect.StdIO
import Effect.System

-- |X,Y co-ordinate
public export
data Pos = MkPos Nat Nat

-- | Two positions are the same if their x and y co-oridinates
--   are equal
implementation Eq Pos where
  (MkPos x1 y1) == (MkPos x2 y2) = (x1 == x2) && (y1 == y2)

implementation Show Pos where
  show (MkPos x y) = "(x : " ++ show x ++ ", y : " ++ show y ++ ")"

-- | A Square can either contain a mine or be adjacent to
--   0 - 8 mines
data SqState = Mine | Safe Nat

-- | A Square can be hidden (not yet pressed) or
--   revealed
data Visibility = Hidden | Revealed

data Square = MkSquare Visibility SqState

-- | Board is m * n squares
export
data Board : Nat -> Nat -> Type where
   MkBoard : (Vect m (Vect n Square)) -> Board m n

strRepeat : Nat -> String -> String
strRepeat Z s = ""
strRepeat (S n) s = s ++ strRepeat n s

concatSV : Vect n String -> String
concatSV Nil = ""
concatSV (v :: vs) = v ++ (concatSV vs)

-- | Display the board, hiding any hidden squares
export
showBoard : (Board rows cols) -> String
showBoard {rows} {cols} board = if rows == 0
  then "Empty"
  else  firstRow ++ "\n" ++ (showRows board)

  where firstRow = strRepeat (2 * cols + 1) "-"

        showRows : (Board rows cols) -> String
        showRows (MkBoard vs) = concatSV $ map (\v => (showRow v) ++ "\n") vs

        where showRow : Vect k Square -> String
              showRow v = "|" ++ rowStr ++ "\n" ++ endStr
                where rowStr = concatSV $ map (\(MkSquare vis st) => case (vis, st) of
                                    (Hidden, _) => "?|"
                                    (Revealed, Mine) => "m|"
                                    (Revealed, Safe Z) => " |"
                                    (Revealed, Safe n) => (show n) ++ "|" ) v

                      -- Line under each Row
                      endStr = (concatSV $ map (\_ => "--") v) ++ "-"

-- | Display the board, revealing all hidden squares
export
showRevealed : (Board rows cols) -> String
showRevealed {rows} {cols} board = if rows == 0
  then "Empty"
  else  firstRow ++ "\n" ++ (showRows board)

  where firstRow = strRepeat (2 * cols + 1) "-"

        showRows : (Board rows cols) -> String
        showRows (MkBoard vs) = concatSV $ map (\v => (showRow v) ++ "\n") vs

        where showRow : Vect k Square -> String
              showRow v = "|" ++ rowStr ++ "\n" ++ endStr
                where rowStr = concatSV $ map (\(MkSquare _ st) => case st of
                                    Mine => "m|"
                                    (Safe Z) => " |"
                                    (Safe n) => (show n) ++ "|" ) v

                      -- Line under each Row
                      endStr = (concatSV $ map (\_ => "--") v) ++ "-"

-- | Prove n = plus n 0
natPlusZ : (n : Nat) -> n = plus n 0
natPlusZ Z = Refl
natPlusZ (S o) = rewrite natPlusZ o in Refl

-- | Apply the given function (k - 1) times to a given value and return
--   all the intermediate values as a vector
iterateV : (k : Nat) -> (a -> a) -> a -> Vect k a
iterateV k f b = rewrite (natPlusZ k) in (reverse $ iterateV' k b Nil)
  where iterateV' : (m : Nat) -> a -> (Vect n a) -> (Vect (m + n) a)
        iterateV' Z _ v = v
        iterateV' (S l) a v {n} = rewrite (plusSuccRightSucc l n) in
                                    iterateV' l (f a) (a :: v)

-- | Given an index, element and vector create a new
--   vector with the given element at that index.
--   If the index is >= the vector size then the same
--   vector is returned
replaceV : Nat -> a -> Vect n a -> Vect n a
replaceV = replaceV' Z
  where replaceV' : Nat -> Nat -> a -> Vect n a -> Vect n a
        replaceV' _ _ _ Nil = Nil
        replaceV' cur pos a (v :: vs) =
          if (cur == pos)
            then a :: vs
            else v :: (replaceV' (cur + 1) pos a vs)

-- | Given row and column number and a Board, attempts
--   to increment the bomb adjacency value of the given
--   square in the board, if the row/col numbers are out
--   of range returns nothing, if the square selected is
--   a mine then the same Board is returned
incBoardSquare : Nat -> Nat -> (Board rows cols) -> Maybe (Board rows cols)
incBoardSquare {rows} {cols} y x (MkBoard v) = do
  rowPos <- natToFin y rows
  colPos <- natToFin x cols
  let row  =index rowPos v
  let square = index colPos row

  let newSquare = case square of
    (MkSquare vis (Safe n)) => (MkSquare vis (Safe (S n)))
    sq => sq

  pure $ MkBoard (replaceV y (replaceV x newSquare row) v)

-- | Attempt to increment the mine adjacency value for all 8 adjacent squares
--   of a given mine position, if the bomb position given is out of bounds then
--   Nothing is returned. Any adjacent squares which aren't on the board are
--   not incremented
incAdjacentSquares : Pos -> (Board rows cols) -> Maybe (Board rows cols)
incAdjacentSquares {rows} {cols} (MkPos x y) board = do
    -- Increment squares to the left of the mine
    leftSide <- incLeftSide board x
    -- Increment squares to the right side of the mine
    rightSide <- incRightSide leftSide cols
    -- Increment squares above and below the mine
    top <- incTop rightSide y
    bot <- incBot top rows

    pure bot

  where
        incTopLeft : (Board rows cols) -> Nat -> Nat -> Maybe (Board rows cols)
        incTopLeft prev Z _ = pure prev
        incTopLeft prev _ Z = pure prev
        incTopLeft prev (S y) (S x) = incBoardSquare y x prev

        incBotLeft : (Board rows cols) -> Nat -> Nat -> Maybe (Board rows cols)
        incBotLeft prev Z _ = pure prev
        incBotLeft prev _ Z = pure prev
        incBotLeft prev (S r) (S x) = if y < r then incBoardSquare (y + 1) x prev else pure prev

        incLeftSide : (Board rows cols) -> Nat -> Maybe (Board rows cols)
        incLeftSide prev Z = pure prev
        incLeftSide prev (S x) = do
            left <- incBoardSquare y x prev
            topLeft <- incTopLeft left y (S x)
            incBotLeft topLeft rows (S x)

        incTopRight : (Board rows cols) -> Nat -> Maybe (Board rows cols)
        incTopRight prev Z = pure prev
        incTopRight prev (S y) = incBoardSquare y (x + 1) prev

        incBotRight : (Board rows cols) -> Nat -> Maybe (Board rows cols)
        incBotRight prev Z = pure prev
        incBotRight prev (S r) = if y < r then incBoardSquare (y + 1) (x + 1) prev else pure prev

        incRightSide : (Board rows cols) -> Nat -> Maybe (Board rows cols)
        incRightSide prev Z = pure prev
        incRightSide prev (S c) = if x < c
          then do
            right <- incBoardSquare y (x + 1) prev
            topRight <- incTopRight right y
            incBotRight topRight rows
          else
            pure prev

        incTop : (Board rows cols) -> Nat -> Maybe (Board rows cols)
        incTop prev Z = pure prev
        incTop prev (S y) = incBoardSquare y x prev

        incBot : Board rows cols -> Nat -> Maybe (Board rows cols)
        incBot prev Z = pure prev
        incBot prev (S r) = if y < r then incBoardSquare (y + 1) x prev else pure prev

-- | Given row and column  dimensions of board with mines generate
--   the board
export
createBoard : (n : Nat) ->  (m : Nat) -> Vect k Pos -> Maybe (Board m n)
createBoard cols rows mines = do
      let initialBoard = MkBoard $ map (\row => generateRow row cols) (iterateV rows (+1) 0)
      calculateState initialBoard

    where generateRow : Nat -> (n : Nat) -> Vect n Square
          generateRow row cols = map (\col => generateSquare row col) (iterateV cols (+1) 0)

          where generateSquare : Nat -> Nat -> Square
                generateSquare row col = MkSquare Hidden sqState
                -- Check if Square is a mine
                where sqState = if (MkPos col row) `elem` mines
                                then Mine
                                else Safe 0

         -- For each non mine square work out the number of adjacent
         -- bombs
          calculateState : Board m n -> Maybe (Board m n)
          calculateState board = calculateState' board mines
            where calculateState' : Board m n -> Vect k Pos -> Maybe (Board m n)
                  calculateState' board Nil = pure board
                  calculateState' board (x :: xs) = do
                    res <- (incAdjacentSquares x board)
                    calculateState' res xs

-- | Determines if the Board is in a "Win" State
--   i.e. all hidden squares are mines
export
checkWin : Board m n -> Bool
checkWin (MkBoard v) = foldl (\b, v => (checkRow v) && b) True v -- Check each row matches win condition
  where checkRow : Vect n Square -> Bool
        checkRow v = foldl (\b, (MkSquare vis st) => case (vis, st) of
                      (Revealed, Safe m) => b -- All safe squares must be revealed
                      (Hidden, Mine) => b  -- Hidden mines are still a win condition
                      _ => b && False) True v

-- | Determines if the Board is in a "Lose" State
--   i.e. a revealed square is a mine
export
checkLose : Board m n -> Bool
checkLose (MkBoard v) = foldl(\b, v => (checkRow v) || b) False v
  where checkRow v = foldl (\b, (MkSquare vis st) => case (vis, st) of
                      (Revealed, Mine) => True -- If any mines are revealed, the player loses
                      _ => b || False) False v

-- Reveals the given position, returns the new Board state
-- if a square is revealed, otherwise returns an error message
-- if the square has already been revealed or it's out of bounds
export
reveal : Pos -> Board rows cols -> Either String (Board rows cols)
reveal (MkPos x y) board@(MkBoard v) = do
  rowPos <- maybeToEither "Out Of Bounds." (natToFin y rows)
  colPos <- maybeToEither "Out Of Bounds." (natToFin x cols)
  let row  =index rowPos v
  let square = index colPos row

  case square of
    (MkSquare Revealed _) => Left "Square has already been revealed"

    -- No surrounding mines, reveal all squares surrounding the revealed square
    (MkSquare Hidden (Safe Z)) => do
        let newSq = MkSquare Revealed (Safe Z)
        pure (MkBoard (replaceV y (replaceV x newSq row) v)) >>=

          \b => pure (revealTop b y) >>=
          \b => pure (revealLeft b x) >>=
          \b => pure (revealTopLeft b y x) >>=
          \b => pure (revealNoErr (MkPos x       (y + 1)) b) >>=
          \b => pure (revealNoErr (MkPos (x + 1) y      ) b) >>=
          \b => pure (revealNoErr (MkPos (x + 1) (y + 1)) b)

    (MkSquare Hidden sq) => do
        let newSq = MkSquare Revealed sq
        pure $ MkBoard (replaceV y (replaceV x newSq row) v)

 -- Reveals the given position, returns the new Board state
 -- if a square is revealed, otherwise returns the old board state
 where revealNoErr : Pos -> Board rows cols -> Board rows cols
       revealNoErr p b = case reveal p b of
                           (Right newB) => newB
                           (Left _) => b

       revealLeft : Board rows cols -> Nat -> Board rows cols
       revealLeft prev Z = prev
       revealLeft prev (S x) = revealNoErr (MkPos x (y + 1)) (revealNoErr (MkPos x y) prev)

       revealTop : Board rows cols -> Nat -> Board rows cols
       revealTop prev Z = prev
       revealTop prev (S y) = revealNoErr (MkPos (x + 1) y) (revealNoErr (MkPos x y) prev)

       revealTopLeft : Board rows cols -> Nat -> Nat -> Board rows cols
       revealTopLeft prev Z _ = prev
       revealTopLeft prev _ Z = prev
       revealTopLeft prev y x = revealNoErr (MkPos x y) prev

-- | Given x and y dimensions and a vector containing
--   the positions of already generated mines, places a mine
--   in a position which isn't contained in the given vector
generateMine : Nat -> Nat -> (Vect n Pos) -> {[RND]} Eff Pos
generateMine x y mines = do
  xPos <- rndInt 0 (toIntegerNat x)
  yPos <- rndInt 0 (toIntegerNat y)
  let mine = MkPos (fromIntegerNat xPos) (fromIntegerNat yPos)

  -- If position already taken then attempt to regenerate
  if mine `elem` mines
    then pure $ placeRightMine mine
    else pure mine

 where placeRightMine : Pos -> Pos
       placeRightMine (MkPos col row) =
            if nextPos `elem` mines
              then placeRightMine nextPos
              else nextPos

           -- Modulo giving strange division by 0 runtime error,
           -- so calculate next square to the right manually
           where nextCol : Nat
                 nextCol = if (S col) == x then Z else (S col)
                 nextRow : Nat
                 nextRow = if nextCol == Z
                              then if ((S row) == y) then Z else (S row)
                              else row
                 nextPos = (MkPos nextCol nextRow)

-- | Given x and y dimensions and number of mines to create
--   creates a vector containing positions of randomly placed mines.
--  if there are more mines than x * y spaces then Nothing is returned.
--  To guarantee termination if a collision occurs then a mine is attempted
--  to be placed to the right of the mine until a free space is hit
generateMines' : Nat -> Nat -> (n : Nat) -> {[RND]} Eff (Vect (n) Pos)
generateMines' x y nMines = rewrite (natPlusZ nMines) in
                                generateMines'' nMines Nil

  where generateMines'' : (m : Nat) -> (Vect k Pos) -> {[RND]} Eff (Vect (m + k)  Pos)
        generateMines'' Z v = pure v
        generateMines'' {k} (S l) mines =
					(generateMine x y mines) >>=
					\mine => rewrite (plusSuccRightSucc l k) in generateMines'' l (mine ::mines)

export
generateMines : Nat -> Nat -> (n : Nat) -> {[SYSTEM, RND]} Eff (Maybe (Vect n Pos))
generateMines x y nMines =
  if (x * y < nMines)
    then pure Nothing
    else do
      -- Use current system time as RNG seed
      t <- time
      srand t
      pure $ Just !(generateMines' x y nMines)