module Main

import Data.Vect

%default total

data Store : Type where
  Create : (size : Nat) ->
           (elems : Vect size String) ->
           Store
{-
  Splitting up the Commands for Processing from the strings that represent them
  is what makes easier to isolate parsing and it's failure modes from the
  processing.
-}
data Command = Add String
             | Get Integer
             | Search String
             | Size
             | Quit

size : Store -> Nat
size (Create size' elems') = size'

items : (store : Store) -> Vect (size store) String
items (Create size' elems') = elems'

add : (store : Store) -> String -> Store
add (Create size elems) newElem = Create _ (elems ++ [newElem])

getByIndex : (store : Store) -> (pos : Integer) -> String
getByIndex store pos = case integerToFin pos (size store) of
                            Nothing => "Out of Range"
                            Just pos' => index pos' (items store)

getIndexByElement : (store : Store) -> (el : String) -> String
getIndexByElement store el = case elemIndex el (items store) of
                                 Just i => show (finToNat i)
                                 Nothing => "?"

search : (store : Store) -> (query : String) -> (n : Nat ** Vect n String)
search store query = filter (isInfixOf query) (items store)

formatMatches : (store : Store) -> (results : (n : Nat ** Vect n String)) -> String
formatMatches store (_ ** []) = "No matches\n"
formatMatches store (n ** rs) = foldr (++) "" (map resultToString rs)
  where
    resultToString : String -> String
    resultToString r = (getIndexByElement store r) ++ ": " ++ r ++ "\n"

run : Store -> Command -> Maybe (String, Store)
run store (Search query) = let results = search store query in
                               Just( (formatMatches store results), store )
run store (Add item) = Just ("ID: " ++ show (size store) ++ "\n", add store item)
run store (Get pos) = Just ("Result: " ++ show (getByIndex store pos) ++ "\n", store)
run store Size = Just (show (size store) ++ " item(s)\n", store)
run store Quit = Nothing

cleanInputs : String -> (String, String)
cleanInputs input = case (span (/= ' ') input) of
                         (cmd, args) => (toLower cmd, ltrim args)

parseCommand : (cmd : String) -> (args : String) -> Maybe Command
parseCommand "get" index = case all isDigit (unpack index) of
                                False => Nothing
                                True => Just (Get (cast index))
parseCommand "search" query = Just (Search query)
parseCommand "add" value = Just (Add value)
parseCommand "size" ""  = Just Size
parseCommand "quit" ""  = Just Quit
parseCommand _  _ = Nothing

parse : (input : String) -> Maybe Command
parse input = case cleanInputs input of
                   (cmd, args) => parseCommand cmd args

processInput : Store -> String -> Maybe (String, Store)
processInput store input
= case parse input of
       Just validCommand => run store validCommand
       Nothing => Just ("Invalid command\n", store)

partial main : IO ()
main = replWith (Create _ []) "Command > " processInput


module Issue835

baz : (x : Nat) -> {P2 : Nat -> Type} -> P2 x
baz x = ?rhs3

foo : {P : Nat -> Type}  -> Dec (P 0)
foo = ?rhs1 where

  bar : {P2 : Nat -> Type} ->
          (x : Nat)
          -> P2 x
  bar x with (S x)
     bar x | x1 =  ?rhs2


module Data.Verified.Trifunctor

import Data.Trifunctor

%default total
%access public export

||| Verified Trifunctor
||| A Trifunctor for which identity and composition laws are verified
interface Trifunctor t => VerifiedTrifunctor (t : Type -> Type -> Type -> Type) where
  trifunctorIdentity : {a : Type} -> {b : Type} -> {c : Type} ->
                       (x : t a b c) ->
                       timap Basics.id Basics.id Basics.id x = x
  trifunctorComposition : {a : Type} -> {b : Type} -> {c : Type} ->
                          {a1 : Type} -> {b1 : Type} -> {c1 : Type} ->
                          (x : t a b c) ->
                          (fa1 : a -> a1) -> (fb1 : b -> b1) -> (fc1 : c -> c1) ->
                          (fa2 : a1 -> a2) -> (fb2 : b1 -> b2) -> (fc2 : c1 -> c2) ->
                          (timap (fa2 . fa1) (fb2 . fb1) (fc2 . fc1) x) =
                          (timap fa2 fb2 fc2 . timap fa1 fb1 fc1) x


-- exercises in "Type-Driven Development with Idris"
-- chapter 4

-- check that all functions are total
%default total

||| Powersources for vehicles
data PowerSource = Petrol | Pedal | Electric

||| Vehicles
data Vehicle : PowerSource -> Type where
  Unicycle : Vehicle Pedal
  Bicycle : Vehicle Pedal
  Motorcycle : (fuel : Nat) -> Vehicle Petrol
  Car : (fuel : Nat) -> Vehicle Petrol
  Bus : (fuel : Nat) -> Vehicle Petrol
  Tram : Vehicle Electric
  ElectricCar : Vehicle Electric

wheels : Vehicle power -> Nat
wheels Unicycle = 1
wheels Bicycle = 2
wheels (Motorcycle fuel) = 2
wheels (Car fuel) = 4
wheels (Bus fuel) = 4
wheels Tram = 10
wheels ElectricCar = 4

refuel : Vehicle Petrol -> Vehicle Petrol
refuel (Motorcycle fuel) = Motorcycle 50
refuel (Car fuel) = Car 100
refuel (Bus fuel) = Bus 200
refuel Unicycle impossible
refuel Bicycle impossible
refuel Tram impossible
refuel ElectricCar impossible


{-data SnocList ty = Empty | Snoc (SnocList ty) ty

reverseSnoc : SnocList ty -> List ty
reverseSnoc Empty = []
reverseSnoc (Snoc xs x) = x :: reverseSnoc xs-}

data SnocList : List a -> Type where
  Empty : SnocList []
  Snoc : (rec : SnocList xs) -> SnocList (xs ++ [x])

snocListHelp : (snoc : SnocList input) -> (rest : List a) ->
               SnocList (input ++ rest)
snocListHelp {input} snoc [] = rewrite appendNilRightNeutral input in snoc
snocListHelp {input} snoc (x :: xs) = rewrite appendAssociative input [x] xs in
                                      snocListHelp (Snoc snoc {x}) xs

snocList : (xs : List a) -> SnocList xs
snocList xs = snocListHelp Empty xs

myReverseHelper : (input : List a) -> SnocList input -> List a
myReverseHelper [] Empty = []
myReverseHelper (xs ++ [x]) (Snoc rec) = x :: myReverseHelper xs rec

{-myReverse : List a -> List a
myReverse xs = myReverseHelper xs (snocList xs)-}

myReverse : List a -> List a
myReverse input with (snocList input)
  myReverse [] | Empty = []
  myReverse (xs ++ [x]) | (Snoc rec) = x :: myReverse xs | rec

isSuffix : Eq a => List a -> List a -> Bool
isSuffix input1 input2 with (snocList input1)
  isSuffix [] input2 | Empty = True
  isSuffix (xs ++ [x]) input2 | (Snoc xsrec) with (snocList input2)
    isSuffix (xs ++ [x]) [] | (Snoc xsrec) | Empty = False
    isSuffix (xs ++ [x]) (ys ++ [y]) | (Snoc xsrec) | (Snoc ysrec)
      = if x == y then isSuffix xs ys | xsrec | ysrec
                  else False

data SplitRec : List a -> Type where
  SplitRecNil : SplitRec []
  SplitRecOne : SplitRec [x]
  SplitRecPair : (lrec : Lazy (SplitRec lefts)) ->
                 (rrec : Lazy (SplitRec rights)) ->
                 SplitRec (lefts ++ rights)

total splitRec : (xs : List a) -> SplitRec xs


module Data.List.Fixes

%default total
%access export

public export
data PrefixOfBy : (holdsFor : type -> type -> Type)
               -> (pref  : List type)
               -> (input : List type)
               -> Type where
   Empty  : PrefixOfBy p Nil xs
   Extend : (prf : p x y)
         -> PrefixOfBy p xs ys
         -> PrefixOfBy p (x::xs) (y::ys)

rightIsEmpty : PrefixOfBy p (x :: xs) [] -> Void
rightIsEmpty Empty impossible
rightIsEmpty (Extend _ _) impossible

notPrefix : (contra : p x y -> Void)
         -> PrefixOfBy p (x :: xs) (y :: ys)
         -> Void
notPrefix contra (Extend prf x) = contra prf

restNotPrefix : (contra : PrefixOfBy p xs ys -> Void)
             -> PrefixOfBy p (x :: xs) (y :: ys)
             -> Void
restNotPrefix contra (Extend x y) = contra y

isPrefixOfBy : (test : (x,y : type) -> Dec (p x y))
            -> (pref, input : List type)
            -> (Dec $ PrefixOfBy p pref input)
isPrefixOfBy test [] input = Yes Empty
isPrefixOfBy test (x :: xs) [] = No rightIsEmpty
isPrefixOfBy test (x :: xs) (y :: ys) with (test x y)
  isPrefixOfBy test (x :: xs) (y :: ys) | (Yes prf) with (isPrefixOfBy test xs ys)
    isPrefixOfBy test (x :: xs) (y :: ys) | (Yes prf) | (Yes z) = Yes (Extend prf z)
    isPrefixOfBy test (x :: xs) (y :: ys) | (Yes prf) | (No contra) =
      No (restNotPrefix contra)

  isPrefixOfBy test (x :: xs) (y :: ys) | (No contra) =
      No (notPrefix contra)

isPrefixOf : DecEq type
          => (pref, input : List type)
          -> Dec $ PrefixOfBy (=) pref input
isPrefixOf = isPrefixOfBy decEq

public export
SuffixOfBy : (holdsFor : type -> type -> Type)
          -> (pref  : List type)
          -> (input : List type)
          -> Type
SuffixOfBy holdsFor pref input =
  PrefixOfBy holdsFor (reverse pref) (reverse input)

isSuffixOfBy : (test : (x,y : type) -> Dec (p x y))
            -> (pref, input : List type)
            -> (Dec $ SuffixOfBy p pref input)
isSuffixOfBy test pref input =
  isPrefixOfBy test (reverse pref) (reverse input)

isSuffixOf : DecEq type
          => (suf, input : List type)
          -> (Dec $ SuffixOfBy (=) suf input)
isSuffixOf suf input =
  isSuffixOfBy decEq suf input


module Data.Compress.Utils.Misc

import Data.Fin
import Data.Vect
import Data.List
import Data.Bits
import Data.List1
import Data.SnocList

export
take_last : Nat -> SnocList a -> Maybe (List a)
take_last = loop Lin where
  loop : SnocList a -> Nat -> SnocList a -> Maybe (List a)
  loop acc Z _ = Just (asList acc)
  loop acc (S n) (init :< last) = loop (acc :< last) n init
  loop acc _ Lin = Nothing

export
stream_concat : Stream (List a) -> Stream a
stream_concat ([] :: ys) = stream_concat ys
stream_concat ((x :: xs) :: ys) = x :: stream_concat (xs :: ys)

export
index_may : Nat -> List a -> Maybe a
index_may Z (x :: xs) = Just x
index_may (S n) (x :: xs) = index_may n xs
index_may _ [] = Nothing

export
count : Ord a => List a -> List (a, Nat)
count = map (\xs => (head xs, length xs)) . group . sort


module Data.Queue1

import Data.List
import Data.List1
import Data.SnocList

%default total

-------------
--- Queue ---
-------------

-- add from right, remove from left
export
record Queue1 a where
  constructor MkQueue
  right : SnocList a
  left  : List1 a

export
singleton : a -> Queue1 a
singleton = MkQueue [<] . singleton

export
add : a -> Queue1 a -> Queue1 a
add x = { right $= (:< x) }

-- Constructs a `Queue1` which has all elements in the left part of the queue reverted
%inline
pureLeftsFromSnoc : SnocList a -> Maybe $ Queue1 a
pureLeftsFromSnoc = map (MkQueue [<]) . fromList . cast

export
remove : Queue1 a -> (a, Lazy (Maybe $ Queue1 a))
remove $ MkQueue r (head ::: l) = (head,) $ delay $ case l of
  []      => pureLeftsFromSnoc r
  (x::xs) => Just $ MkQueue r (x:::xs)

export
Functor Queue1 where
  map f = { left $= map f, right $= map f }

export
filter : (a -> Bool) -> Queue1 a -> Maybe $ Queue1 a
filter f $ MkQueue r l = do
  let filteredR = filter f r
  let Just filteredL = fromList $ filter f $ toList l
    | Nothing => pureLeftsFromSnoc filteredR
  Just $ MkQueue filteredR filteredL

||| Returns a `List1` with newly added elements on the right and older elements in the left
export
toList1 : Queue1 a -> List1 a
toList1 $ MkQueue r l = l `appendl` cast r


module Q
import ZZ
import GCDZZ
import Divisors
import Monoid
import Rationals
import ZZUtils
import TwoVarDiophEq
import NatUtils

|||data type for rationals
data Q : Type where
  PbySq : (p: ZZ) -> (q: Nat) -> Q

ZQ : Q
ZQ = PbySq (Pos Z) Z

OneQ : Q
OneQ = PbySq (Pos (S Z)) Z

|||data type which has the simplified form of a Rational number, a transversal group
data SimpQ : Type where
 SimplifiedQ : (p:ZZ) -> (q:ZZ) -> .(IsPositive q) -> .(GCDZ p q 1) -> SimpQ

--Auxillary conversions to convert Q into a SimpQ
QtoZZPair : Q -> ZZPair
QtoZZPair (PbySq p q) = (p, Pos(S q))

SimplifyToZZPair : (x:Q)-> (y: ZZPair ** (GCDZ (fst y) (snd y) 1))
SimplifyToZZPair (PbySq p q)= simplifyWithProof (QtoZZPair (PbySq p q)) (PositiveZ{k=q})

ZZPairtoQ : ZZPair -> Q
ZZPairtoQ (p, Pos(S q)) = PbySq p q

--auxillary functions for conversion of data types

blah: {b:ZZ}-> {d:ZZ}-> (IsPositive b) -> (IsPositive d) -> (x: IsDivisibleZ b d) -> (IsPositive (fst x))
blah Positive Positive ((Pos Z) ** pf) =  void (posIsNotPosTimesZero pf)
blah Positive Positive ((NegS l)** pf) = void(PosTimesNegIsNotPos pf)
blah Positive Positive ((Pos (S l))**pf) = Positive

dDivsb: (GCDZ a b d) -> (IsDivisibleZ b d)
dDivsb dgcdab = (snd (fst (snd dgcdab)))
-- aux end

ZZtoSimpQ : (p:ZZ) ->(q:ZZ) -> (pf: IsPositive q) -> (d : ZZ ** GCDZ p q d) -> SimpQ
ZZtoSimpQ p q pf (d**dgcdab) = SimplifiedQ (aByd dgcdab) (fst (dDivsb dgcdab)) (blah pf (fst dgcdab) (dDivsb dgcdab)) (divideByGcdThenGcdOne dgcdab)

|||Simplifies a rational number to its coprime form
QtoSimpQ : Q -> SimpQ
QtoSimpQ (PbySq p q) = ZZtoSimpQ p (Pos(S q)) Positive (gcdZZ p (Pos (S q)) RightPositive)

|||addition over rational number
addQ: Q -> Q -> Q
addQ (PbySq p1 q1) (PbySq p2 q2) =
  let
    num : ZZ = (p1 * (Pos(S q2))) + (p2 * (Pos (S q1)))
    denom: Nat = q1 * q2 + q1 + q2
  in
  PbySq num denom

|||addition over the transversal group
addSimpQ : SimpQ -> SimpQ -> SimpQ
addSimpQ (SimplifiedQ p1 (Pos(S q1)) Positive gcd1) (SimplifiedQ p2 (Pos(S q2)) Positive gcd2) =
                                          QtoSimpQ (addQ (PbySq p1 q1) (PbySq p2 q2))

||| multiplication over Rationals
multQ: Q-> Q -> Q
multQ (PbySq p1 q1) (PbySq p2 q2) = PbySq (p1 * p2) (q1 * q2 + q1 + q2)

|||Multiplication over the transversal group
multSimpQ : SimpQ -> SimpQ -> SimpQ
multSimpQ (SimplifiedQ p1 (Pos(S q1)) Positive gcd1) (SimplifiedQ p2 (Pos(S q2)) Positive gcd2) =
                                          QtoSimpQ (multQ (PbySq p1 q1) (PbySq p2 q2))

--Conversions from integers to aforementioned types
ZZtoQ : ZZ  -> Q
ZZtoQ x = PbySq x Z

IntegertoQ : Integer -> Q
IntegertoQ x = ZZtoQ(fromInt x)

IntegertoSimpQ : Integer -> SimpQ
IntegertoSimpQ x = QtoSimpQ (IntegertoQ x)

--defining the + and * signs for Q and SimpQ
implementation Num Q where
  (+) = addQ
  (*) = multQ
  fromInteger = IntegertoQ

implementation Num SimpQ where
  (+) = addSimpQ
  (*) = multSimpQ
  fromInteger = IntegertoSimpQ

|||Proves that addition over Q is commutative
addQIsComm : (x:Q)->(y: Q)-> (x+y=y+x)
addQIsComm (PbySq p1 q1) (PbySq p2 q2) =
  rewrite plusCommutativeZ (p1 * (Pos(S q2))) (p2 * (Pos (S q1))) in
  rewrite multCommutative q1 q2 in
  rewrite plusCommutative (q2*q1 + q1) q2 in
  rewrite plusAssociative q2 (q2 * q1) q1 in
  rewrite plusCommutative q2 (q2 * q1) in
  Refl
--auxillary function
apYX : (x: Type)->(y: Type) -> (f: y -> x) -> (n: y) -> (m: y) -> n = m -> f n = f m
apYX x y f m m Refl = Refl

{-
addSimpQisComm : (x: SimpQ) -> (y: SimpQ) ->(x+y = y+x)
addSimpQisComm (SimplifiedQ p1 (Pos(S q1)) Positive gcd1) (SimplifiedQ p2 (Pos(S q2)) Positive gcd2) =
  let
  sum :Q = ( (PbySq p1 q1)+(PbySq p2 q2))
  in
  rewrite addQIsComm (PbySq p1 q1) (PbySq p2 q2) in
  Refl
-}

|||proves that multiplication over Q is commutative
multQisComm : (x:Q)-> (y: Q) -> (x*y = y*x)
multQisComm (PbySq p1 q1) (PbySq p2 q2) =
  rewrite multCommutativeZ p1 p2 in
  rewrite multCommutative q1 q2 in
  rewrite plusCommutative (q2*q1 + q1) q2 in
  rewrite plusAssociative q2 (q2 * q1) q1 in
  rewrite plusCommutative q2 (q2 * q1) in
  Refl

|||Functions to give the IsIdentity type for Q over *
leftMultId : (r : Q) -> (OneQ * r = r)
leftMultId (PbySq p q) = rewrite multOneLeftNeutralZ p in Refl

RightMultId : (r: Q)-> (r * OneQ = r)
RightMultId r = trans (multQisComm r OneQ) (leftMultId r)

OneIsQMultId : (a: Q) -> (a*OneQ =a, OneQ * a = a)
OneIsQMultId a = (RightMultId a, leftMultId a)

|||functions to give the IsIdentity type for Q over +
leftAddId : (r : Q) ->  (ZQ + r = r)
leftAddId (PbySq p q) =
  rewrite multOneRightNeutralZ p in
  rewrite plusZeroLeftNeutralZ p in
  Refl

rightAddId : (r: Q) -> (r + ZQ = r)
rightAddId r = trans (addQIsComm r ZQ) (leftAddId r)

ZIsQAddId : (a:Q)->((a+ZQ)=a, (ZQ+a)=a)
ZIsQAddId a = (rightAddId a, leftAddId a)

|||Auxillary functions
multZero : (n: Nat) -> mult n Z = Z
multZero Z = Refl
multZero (S k) = multZero k

Aux1 : (n: Nat) -> (q : Nat) -> Nat -> Q
Aux1 n q m = PbySq (Pos (plus m n)) q

Aux2: (n: Nat) -> (q: Nat) -> Nat -> Q
Aux2 n q m = PbySq (plusZ (plusZ (Pos 0) (negNat m)) (NegS n)) q
{-
||| The IdentityExists type for Q over +
QAddIdExists : Type
QAddIdExists = (ZQ ** (ZIsQAddId))
-}


module Main

import Data.Nat
import Data.Vect
import Data.List
import LinearTypes
import Control.Linear.LIO
import Unitary
import QStateT
import Teleportation
import System.Random
import Injection
import QFT
import Grover
import AlterningBitsOracle
import VQE
import Complex
import QuantumOp
import CoinToss
import QAOA
import Graph
import Examples
import RUS

-- %default total

||| Perform 1000 fair coin tosses and count the number of heads
||| (via simulating the quantum dynamics).
testCoins : IO ()
testCoins = do
  let f = coin {t = SimulatedOp}
  s <- sequence (Data.List.replicate 1000 f)
  let heads = filter (== True) s
  putStrLn $ "Number of heads: " ++ (show (length heads))

||| Call the drawTeleportation function (using the SimulatedOp implementation)
||| then execute the runTeleportation function 1000 times and report on the
||| observed measurement results on the third qubit
||| (which is in state |+> at the end of the teleportation protocol).
export
testTeleport : IO ()
testTeleport = do
  drawTeleportation {t = SimulatedOp}
  l <- sequence (Data.List.replicate 1000 (runTeleportation {t = SimulatedOp}))
  let nbT = length $ filter (\x => (last x) == True) l
  putStrLn "\n\nFor 1000 measurements"
  putStrLn ("Number of True measurements : " ++ show nbT)

||| Test graph for the QAOA problem
export
graph1 : Graph 5
graph1 = AddVertex (AddVertex (AddVertex (AddVertex (AddVertex Empty []) [True]) [True, True]) [False, True, False]) [False, False, True, True]

||| Execute QAOA with 100 samples on the previous graph to solve the MAXCUT problem
export
testQAOA : IO (Cut 5)
testQAOA = do
  QAOA {t = SimulatedOp} 100 1 graph1

||| Small test for the VQE algorithm
export
testVQE : IO Double
testVQE = do
  putStrLn "Test VQE"
  let hamiltonian = [(2, [PauliX, PauliY]),(3,[PauliZ, PauliI])]
  VQE {t = SimulatedOp} 2 hamiltonian 5 10 5

export
main : IO ()
main = do

  -- Execute the example file and draw the circuit examples
  drawExamples

  -- Draw the Quantum Fourier Transform for n = 3
--  putStrLn "\n\n\nQuantum Fourier Transform for n = 3"
--  draw (qft 3)

  -- Execute the coin toss example
  putStrLn "\nTest coin toss by performing 1000 coin tosses."
  testCoins

  -- Teleportation protocol
--  putStrLn "\nTest Teleportation protocol"
--  testTeleport

  -- Repeat until success
  putStrLn "\nTest 'Repeat Until Success'. Probability to measure '1' is 2/3 for this example."
  testMultipleRUS 10000

  -- VQE
--  putStrLn "\nSmall test with VQE"
--  r <- testVQE
--  putStrLn $ "result from VQE : " ++ show r

  -- QAOA
--  putStrLn "\nSmall test with QAOA"
--  cut <- testQAOA
--  putStrLn $ "result from QAOA : " ++ show cut

  pure ()


module Data.Utils

import Data.Vect

export
enumerateVect : {n : Nat} -> Vect n a -> Vect n (Int, a)
enumerateVect l = enumerate' 0 l where
  enumerate' : {n : Nat} -> Int -> Vect n a -> Vect n (Int, a)
  enumerate' _ [] = []
  enumerate' i (x::xs) = (i, x)::(enumerate' (i+1) xs)


totalLen : List String -> Nat
totalLen xs = foldr (\el, acc  => length el  + acc) 0 xs


module Data.List

import Data.Nat
import Data.List1

public export
isNil : List a -> Bool
isNil [] = True
isNil _  = False

public export
isCons : List a -> Bool
isCons [] = False
isCons _  = True

public export
snoc : List a -> a -> List a
snoc xs x = xs ++ [x]

public export
take : Nat -> List a -> List a
take (S k) (x :: xs) = x :: take k xs
take _ _ = []

public export
drop : (n : Nat) -> (xs : List a) -> List a
drop Z     xs      = xs
drop (S n) []      = []
drop (S n) (_::xs) = drop n xs

||| Satisfiable if `k` is a valid index into `xs`
|||
||| @ k the potential index
||| @ xs the list into which k may be an index
public export
data InBounds : (k : Nat) -> (xs : List a) -> Type where
    ||| Z is a valid index into any cons cell
    InFirst : InBounds Z (x :: xs)
    ||| Valid indices can be extended
    InLater : InBounds k xs -> InBounds (S k) (x :: xs)

public export
Uninhabited (InBounds k []) where
    uninhabited InFirst impossible
    uninhabited (InLater _) impossible

||| Decide whether `k` is a valid index into `xs`
public export
inBounds : (k : Nat) -> (xs : List a) -> Dec (InBounds k xs)
inBounds _ [] = No uninhabited
inBounds Z (_ :: _) = Yes InFirst
inBounds (S k) (x :: xs) with (inBounds k xs)
  inBounds (S k) (x :: xs) | (Yes prf) = Yes (InLater prf)
  inBounds (S k) (x :: xs) | (No contra)
      = No $ \(InLater y) => contra y

||| Find a particular element of a list.
|||
||| @ ok a proof that the index is within bounds
public export
index : (n : Nat) -> (xs : List a) -> {auto ok : InBounds n xs} -> a
index Z (x :: xs) {ok = InFirst} = x
index (S k) (_ :: xs) {ok = InLater _} = index k xs

||| Generate a list by repeatedly applying a partial function until exhausted.
||| @ f the function to iterate
||| @ x the initial value that will be the head of the list
public export
iterate : (f : a -> Maybe a) -> (x : a) -> List a
iterate f x  = x :: case f x of
  Nothing => []
  Just y => iterate f y

public export
takeWhile : (p : a -> Bool) -> List a -> List a
takeWhile p []      = []
takeWhile p (x::xs) = if p x then x :: takeWhile p xs else []

public export
dropWhile : (p : a -> Bool) -> List a -> List a
dropWhile p []      = []
dropWhile p (x::xs) = if p x then dropWhile p xs else x::xs

public export
filter : (p : a -> Bool) -> List a -> List a
filter p [] = []
filter p (x :: xs)
   = if p x
        then x :: filter p xs
        else filter p xs

||| Find the first element of the list that satisfies the predicate.
public export
find : (p : a -> Bool) -> (xs : List a) -> Maybe a
find p [] = Nothing
find p (x::xs) = if p x then Just x else find p xs

||| Find associated information in a list using a custom comparison.
public export
lookupBy : (a -> a -> Bool) -> a -> List (a, b) -> Maybe b
lookupBy p e []      = Nothing
lookupBy p e ((l, r) :: xs) =
  if p e l then
    Just r
  else
    lookupBy p e xs

||| Find associated information in a list using Boolean equality.
public export
lookup : Eq a => a -> List (a, b) -> Maybe b
lookup = lookupBy (==)

||| Check if something is a member of a list using a custom comparison.
public export
elemBy : (a -> a -> Bool) -> a -> List a -> Bool
elemBy p e []      = False
elemBy p e (x::xs) = p e x || elemBy p e xs

public export
nubBy : (a -> a -> Bool) -> List a -> List a
nubBy = nubBy' []
  where
    nubBy' : List a -> (a -> a -> Bool) -> List a -> List a
    nubBy' acc p []      = []
    nubBy' acc p (x::xs) =
      if elemBy p x acc then
        nubBy' acc p xs
      else
        x :: nubBy' (x::acc) p xs

||| O(n^2). The nub function removes duplicate elements from a list. In
||| particular, it keeps only the first occurrence of each element. It is a
||| special case of nubBy, which allows the programmer to supply their own
||| equality test.
|||
||| ```idris example
||| nub (the (List _) [1,2,1,3])
||| ```
public export
nub : Eq a => List a -> List a
nub = nubBy (==)

||| The deleteBy function behaves like delete, but takes a user-supplied equality predicate.
public export
deleteBy : (a -> a -> Bool) -> a -> List a -> List a
deleteBy _  _ []      = []
deleteBy eq x (y::ys) = if x `eq` y then ys else y :: deleteBy eq x ys

||| `delete x` removes the first occurrence of `x` from its list argument. For
||| example,
|||
|||````idris example
|||delete 'a' ['b', 'a', 'n', 'a', 'n', 'a']
|||````
|||
||| It is a special case of deleteBy, which allows the programmer to supply
||| their own equality test.
public export
delete : Eq a => a -> List a -> List a
delete = deleteBy (==)

||| The unionBy function returns the union of two lists by user-supplied equality predicate.
public export
unionBy : (a -> a -> Bool) -> List a -> List a -> List a
unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs

||| Compute the union of two lists according to their `Eq` implementation.
|||
||| ```idris example
||| union ['d', 'o', 'g'] ['c', 'o', 'w']
||| ```
|||
public export
union : Eq a => List a -> List a -> List a
union = unionBy (==)

public export
span : (a -> Bool) -> List a -> (List a, List a)
span p []      = ([], [])
span p (x::xs) =
  if p x then
    let (ys, zs) = span p xs in
      (x::ys, zs)
  else
    ([], x::xs)

public export
break : (a -> Bool) -> List a -> (List a, List a)
break p xs = span (not . p) xs

public export
split : (a -> Bool) -> List a -> List1 (List a)
split p xs =
  case break p xs of
    (chunk, [])          => singleton chunk
    (chunk, (c :: rest)) => cons chunk (split p (assert_smaller xs rest))

public export
splitAt : (n : Nat) -> (xs : List a) -> (List a, List a)
splitAt Z xs = ([], xs)
splitAt (S k) [] = ([], [])
splitAt (S k) (x :: xs)
      = let (tk, dr) = splitAt k xs in
            (x :: tk, dr)

public export
partition : (a -> Bool) -> List a -> (List a, List a)
partition p []      = ([], [])
partition p (x::xs) =
  let (lefts, rights) = partition p xs in
    if p x then
      (x::lefts, rights)
    else
      (lefts, x::rights)

||| The inits function returns all initial segments of the argument, shortest
||| first. For example,
|||
||| ```idris example
||| inits [1,2,3]
||| ```
public export
inits : List a -> List (List a)
inits xs = [] :: case xs of
  []        => []
  x :: xs'  => map (x ::) (inits xs')

||| The tails function returns all final segments of the argument, longest
||| first. For example,
|||
||| ```idris example
||| tails [1,2,3] == [[1,2,3], [2,3], [3], []]
|||```
public export
tails : List a -> List (List a)
tails xs = xs :: case xs of
  []        => []
  _ :: xs'  => tails xs'

||| Split on the given element.
|||
||| ```idris example
||| splitOn 0 [1,0,2,0,0,3]
||| ```
|||
public export
splitOn : Eq a => a -> List a -> List1 (List a)
splitOn a = split (== a)

||| Replaces all occurences of the first argument with the second argument in a list.
|||
||| ```idris example
||| replaceOn '-' ',' ['1', '-', '2', '-', '3']
||| ```
|||
public export
replaceOn : Eq a => a -> a -> List a -> List a
replaceOn a b l = map (\c => if c == a then b else c) l

public export
reverseOnto : List a -> List a -> List a
reverseOnto acc [] = acc
reverseOnto acc (x::xs) = reverseOnto (x::acc) xs

public export
reverse : List a -> List a
reverse = reverseOnto []

||| Construct a list with `n` copies of `x`.
||| @ n how many copies
||| @ x the element to replicate
public export
replicate : (n : Nat) -> (x : a) -> List a
replicate Z     _ = []
replicate (S n) x = x :: replicate n x

||| Compute the intersect of two lists by user-supplied equality predicate.
export
intersectBy : (a -> a -> Bool) -> List a -> List a -> List a
intersectBy eq xs ys = [x | x <- xs, any (eq x) ys]

||| Compute the intersect of two lists according to the `Eq` implementation for the elements.
export
intersect : Eq a => List a -> List a -> List a
intersect = intersectBy (==)

export
intersectAllBy : (a -> a -> Bool) -> List (List a) -> List a
intersectAllBy eq [] = []
intersectAllBy eq (xs :: xss) = filter (\x => all (elemBy eq x) xss) xs

export
intersectAll : Eq a => List (List a) -> List a
intersectAll = intersectAllBy (==)

||| Combine two lists elementwise using some function.
|||
||| If the lists are different lengths, the result is truncated to the
||| length of the shortest list.
export
zipWith : (a -> b -> c) -> List a -> List b -> List c
zipWith _ [] _ = []
zipWith _ _ [] = []
zipWith f (x::xs) (y::ys) = f x y :: zipWith f xs ys

||| Combine two lists elementwise into pairs.
|||
||| If the lists are different lengths, the result is truncated to the
||| length of the shortest list.
export
zip : List a -> List b -> List (a, b)
zip = zipWith \x, y => (x, y)

export
zipWith3 : (a -> b -> c -> d) -> List a -> List b -> List c -> List d
zipWith3 _ [] _ _ = []
zipWith3 _ _ [] _ = []
zipWith3 _ _ _ [] = []
zipWith3 f (x::xs) (y::ys) (z::zs) = f x y z :: zipWith3 f xs ys zs

||| Combine three lists elementwise into tuples.
|||
||| If the lists are different lengths, the result is truncated to the
||| length of the shortest list.
export
zip3 : List a -> List b -> List c -> List (a, b, c)
zip3 = zipWith3 \x, y, z => (x, y, z)

public export
data NonEmpty : (xs : List a) -> Type where
    IsNonEmpty : NonEmpty (x :: xs)

export
Uninhabited (NonEmpty []) where
  uninhabited IsNonEmpty impossible

||| Get the head of a non-empty list.
||| @ ok proof the list is non-empty
public export
head : (l : List a) -> {auto 0 ok : NonEmpty l} -> a
head [] impossible
head (x :: _) = x

||| Get the tail of a non-empty list.
||| @ ok proof the list is non-empty
public export
tail : (l : List a) -> {auto 0 ok : NonEmpty l} -> List a
tail [] impossible
tail (_ :: xs) = xs

||| Retrieve the last element of a non-empty list.
||| @ ok proof that the list is non-empty
public export
last : (l : List a) -> {auto 0 ok : NonEmpty l} -> a
last [] impossible
last [x] = x
last (_::x::xs) = List.last (x::xs)

||| Return all but the last element of a non-empty list.
||| @ ok proof the list is non-empty
public export
init : (l : List a) -> {auto 0 ok : NonEmpty l} -> List a
init [] impossible
init [_] = []
init (x::y::ys) = x :: init (y::ys)

||| Attempt to get the head of a list. If the list is empty, return `Nothing`.
public export
head' : List a -> Maybe a
head' []      = Nothing
head' (x::_) = Just x

||| Attempt to get the tail of a list. If the list is empty, return `Nothing`.
export
tail' : List a -> Maybe (List a)
tail' []      = Nothing
tail' (_::xs) = Just xs

||| Attempt to retrieve the last element of a non-empty list.
|||
||| If the list is empty, return `Nothing`.
export
last' : List a -> Maybe a
last' [] = Nothing
last' xs@(_::_) = Just (last xs)

||| Attempt to return all but the last element of a non-empty list.
|||
||| If the list is empty, return `Nothing`.
export
init' : List a -> Maybe (List a)
init' [] = Nothing
init' xs@(_::_) = Just (init xs)

||| Convert any Foldable structure to a list.
export
toList : Foldable t => t a -> List a
toList = foldr (::) []

||| Prefix every element in the list with the given element
|||
||| ```idris example
||| with List (mergeReplicate '>' ['a', 'b', 'c', 'd', 'e'])
||| ```
|||
export
mergeReplicate : a -> List a -> List a
mergeReplicate sep []      = []
mergeReplicate sep (y::ys) = sep :: y :: mergeReplicate sep ys

||| Insert some separator between the elements of a list.
|||
||| ````idris example
||| with List (intersperse ',' ['a', 'b', 'c', 'd', 'e'])
||| ````
|||
export
intersperse : a -> List a -> List a
intersperse sep []      = []
intersperse sep (x::xs) = x :: mergeReplicate sep xs

||| Given a separator list and some more lists, produce a new list by
||| placing the separator between each of the lists.
|||
||| @ sep the separator
||| @ xss the lists between which the separator will be placed
|||
||| ```idris example
||| intercalate [0, 0, 0] [ [1, 2, 3], [4, 5, 6], [7, 8, 9] ]
||| ```
export
intercalate : (sep : List a) -> (xss : List (List a)) -> List a
intercalate sep xss = concat $ intersperse sep xss

||| Apply a partial function to the elements of a list, keeping the ones at which
||| it is defined.
public export
mapMaybe : (a -> Maybe b) -> List a -> List b
mapMaybe f []      = []
mapMaybe f (x::xs) =
  case f x of
    Nothing => mapMaybe f xs
    Just j  => j :: mapMaybe f xs

--------------------------------------------------------------------------------
-- Special folds
--------------------------------------------------------------------------------

||| Foldl a non-empty list without seeding the accumulator.
||| @ ok proof that the list is non-empty
public export
foldl1 : (a -> a -> a) -> (l : List a)  -> {auto 0 ok : NonEmpty l} -> a
foldl1 f [] impossible
foldl1 f (x::xs) = foldl f x xs

||| Foldr a non-empty list without seeding the accumulator.
||| @ ok proof that the list is non-empty
public export
foldr1 : (a -> a -> a) -> (l : List a)  -> {auto 0 ok : NonEmpty l} -> a
foldr1 f [] impossible
foldr1 f [x] = x
foldr1 f (x::y::ys) = f x (List.foldr1 f (y::ys))

||| Foldl without seeding the accumulator. If the list is empty, return `Nothing`.
public export
foldl1' : (a -> a -> a) -> List a -> Maybe a
foldl1' f [] = Nothing
foldl1' f xs@(_::_) = Just (List.foldl1 f xs)

||| Foldr without seeding the accumulator. If the list is empty, return `Nothing`.
public export
foldr1' : (a -> a -> a) -> List a -> Maybe a
foldr1' f [] = Nothing
foldr1' f xs@(_::_) = Just (List.foldr1 f xs)

--------------------------------------------------------------------------------
-- Sorting
--------------------------------------------------------------------------------

||| Check whether a list is sorted with respect to the default ordering for the type of its elements.
export
sorted : Ord a => List a -> Bool
sorted (x :: xs @ (y :: _)) = x <= y && sorted xs
sorted _ = True

||| Merge two sorted lists using an arbitrary comparison
||| predicate. Note that the lists must have been sorted using this
||| predicate already.
export
mergeBy : (a -> a -> Ordering) -> List a -> List a -> List a
mergeBy order []      right   = right
mergeBy order left    []      = left
mergeBy order (x::xs) (y::ys) =
  -- The code below will emit `y` before `x` whenever `x == y`.
  -- If you change this, `sortBy` will stop being stable, unless you fix `sortBy`, too.
  case order x y of
       LT => x :: mergeBy order xs (y::ys)
       _  => y :: mergeBy order (x::xs) ys

||| Merge two sorted lists using the default ordering for the type of their elements.
export
merge : Ord a => List a -> List a -> List a
merge left right = mergeBy compare left right

||| Sort a list using some arbitrary comparison predicate.
|||
||| @ cmp how to compare elements
||| @ xs the list to sort
export
sortBy : (cmp : a -> a -> Ordering) -> (xs : List a) -> List a
sortBy cmp []  = []
sortBy cmp [x] = [x]
sortBy cmp xs  = let (x, y) = split xs in
    mergeBy cmp
          (sortBy cmp (assert_smaller xs x))
          (sortBy cmp (assert_smaller xs y)) -- not structurally smaller, hence assert
  where
    splitRec : List b -> List a -> (List a -> List a) -> (List a, List a)
    splitRec (_::_::xs) (y::ys) zs = splitRec xs ys (zs . ((::) y))
    splitRec _          ys      zs = (ys, zs [])
    -- In the above base-case clause, we put `ys` on the LHS to get a stable sort.
    -- This is because `mergeBy` prefers taking elements from its RHS operand
    -- if both heads are equal, and all elements in `zs []` precede all elements of `ys`
    -- in the original list.

    split : List a -> (List a, List a)
    split xs = splitRec xs xs id

||| Sort a list using the default ordering for the type of its elements.
export
sort : Ord a => List a -> List a
sort = sortBy compare

export
isPrefixOfBy : (eq : a -> a -> Bool) -> (left, right : List a) -> Bool
isPrefixOfBy p [] _            = True
isPrefixOfBy p _ []            = False
isPrefixOfBy p (x::xs) (y::ys) = p x y && isPrefixOfBy p xs ys

||| The isPrefixOf function takes two lists and returns True iff the first list is a prefix of the second.
export
isPrefixOf : Eq a => List a -> List a -> Bool
isPrefixOf = isPrefixOfBy (==)

export
isSuffixOfBy : (a -> a -> Bool) -> List a -> List a -> Bool
isSuffixOfBy p left right = isPrefixOfBy p (reverse left) (reverse right)

||| The isSuffixOf function takes two lists and returns True iff the first list is a suffix of the second.
export
isSuffixOf : Eq a => List a -> List a -> Bool
isSuffixOf = isSuffixOfBy (==)

||| The isInfixOf function takes two lists and returns True iff the first list
||| is contained, wholly and intact, anywhere within the second.
|||
||| ```idris example
||| isInfixOf ['b','c'] ['a', 'b', 'c', 'd']
||| ```
||| ```idris example
||| isInfixOf ['b','d'] ['a', 'b', 'c', 'd']
||| ```
|||
export
isInfixOf : Eq a => List a -> List a -> Bool
isInfixOf n h = any (isPrefixOf n) (tails h)

||| Transposes rows and columns of a list of lists.
|||
||| ```idris example
||| with List transpose [[1, 2], [3, 4]]
||| ```
|||
||| This also works for non square scenarios, thus
||| involution does not always hold:
|||
|||     transpose [[], [1, 2]] = [[1], [2]]
|||     transpose (transpose [[], [1, 2]]) = [[1, 2]]
export
transpose : List (List a) -> List (List a)
transpose [] = []
transpose (heads :: tails) = spreadHeads heads (transpose tails) where
  spreadHeads : List a -> List (List a) -> List (List a)
  spreadHeads []              tails           = tails
  spreadHeads (head :: heads) []              = [head] :: spreadHeads heads []
  spreadHeads (head :: heads) (tail :: tails) = (head :: tail) :: spreadHeads heads tails

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

export
Uninhabited ([] = Prelude.(::) x xs) where
  uninhabited Refl impossible

export
Uninhabited (Prelude.(::) x xs = []) where
  uninhabited Refl impossible

||| (::) is injective
export
consInjective : forall x, xs, y, ys .
                the (List a) (x :: xs) = the (List b) (y :: ys) -> (x = y, xs = ys)
consInjective Refl = (Refl, Refl)

||| The empty list is a right identity for append.
export
appendNilRightNeutral : (l : List a) -> l ++ [] = l
appendNilRightNeutral []      = Refl
appendNilRightNeutral (_::xs) = rewrite appendNilRightNeutral xs in Refl

||| Appending lists is associative.
export
appendAssociative : (l, c, r : List a) -> l ++ (c ++ r) = (l ++ c) ++ r
appendAssociative []      c r = Refl
appendAssociative (_::xs) c r = rewrite appendAssociative xs c r in Refl

revOnto : (xs, vs : List a) -> reverseOnto xs vs = reverse vs ++ xs
revOnto _ [] = Refl
revOnto xs (v :: vs)
    = rewrite revOnto (v :: xs) vs in
        rewrite appendAssociative (reverse vs) [v] xs in
                                  rewrite revOnto [v] vs in Refl

export
revAppend : (vs, ns : List a) -> reverse ns ++ reverse vs = reverse (vs ++ ns)
revAppend [] ns = rewrite appendNilRightNeutral (reverse ns) in Refl
revAppend (v :: vs) ns
    = rewrite revOnto [v] vs in
        rewrite revOnto [v] (vs ++ ns) in
          rewrite sym (revAppend vs ns) in
            rewrite appendAssociative (reverse ns) (reverse vs) [v] in
              Refl

export
dropFusion : (n, m : Nat) -> (l : List t) -> drop n (drop m l) = drop (n+m) l
dropFusion  Z     m    l      = Refl
dropFusion (S n)  Z    l      = rewrite plusZeroRightNeutral n in Refl
dropFusion (S n) (S m) []     = Refl
dropFusion (S n) (S m) (x::l) = rewrite plusAssociative n 1 m in
                                rewrite plusCommutative n 1 in
                                dropFusion (S n) m l

export
lengthMap : (xs : List a) -> length (map f xs) = length xs
lengthMap [] = Refl
lengthMap (x :: xs) = cong S (lengthMap xs)


||| There are different flavours of induction-recursion. This is the one
||| introduced in Dybjer and Setzer's paper:
||| Indexed induction-recursion

module Data.InductionRecursion.DybjerSetzer

public export
data Code : (input : sort -> Type) -> (output : Type) -> Type where
  Yield  : output -> Code input output
  Store  : (payload : Type) -> (payload -> Code input output) -> Code input output
  Branch : (label : Type) -> (toSort : label -> sort) ->
           (((l : label) -> input (toSort l)) -> Code input output) ->
           Code input output

public export
DecodeType
  : Code input output -> (x : sort -> Type) ->
    (f : {s : sort} -> x s -> input s) ->
    Type
DecodeType (Yield _) x f = ()
DecodeType (Store payload k) x f = (v : payload ** DecodeType (k v) x f)
DecodeType (Branch label toSort k) x f
  = (r : ((l : label) -> x (toSort l)) ** DecodeType (k (\ l => f (r l))) x f)

public export
DecodeOutput
  : (c : Code input output) -> (x : Lazy (sort -> Type)) ->
    (f : {s : sort} -> x s -> input s) ->
    DecodeType c x f -> output
DecodeOutput (Yield o) x f _ = o
DecodeOutput (Store p k) x f (v ** d) = DecodeOutput (k v) x f d
DecodeOutput (Branch l s k) x f (r ** d) = DecodeOutput (k (\ l => f (r l))) x f d

mutual

  public export
  data Mu : (f : (s : sort) -> Code input (input s)) -> (s : sort) -> Type where
    MkMu : {f : (s : sort) -> Code input (input s)} -> {s : sort} ->
           DecodeType (f s) (Mu f) Decode -> Mu {input} f s

  public export
  Decode : {f : (s : sort) -> Code input (input s)} ->
           {s : sort} -> Mu {input} f s -> input s
  Decode (MkMu d) = DecodeOutput (f s) (Mu f) (\ d => assert_total (Decode d)) d

public export
bind : Code i o -> (o -> Code i o') -> Code i o'
bind (Yield v) f = f v
bind (Store p k) f = Store p (\ v => bind (k v) f)
bind (Branch l s k) f = Branch l s (\ r => bind (k r) f)

public export
Functor (Code i) where
  map f v = bind v (Yield . f)

public export
Applicative (Code i) where
  pure = Yield
  cf <*> co = bind cf (\ f => map (f $) co)

public export
Monad (Code i) where
  (>>=) = bind


module Hezarfen.FunDefn

import Hezarfen.Prover
import Hezarfen.Simplify
import Language.Reflection.Utils

%access public export

||| Looking at a proof term, collect the initial lambda argument names and
||| their types, and return the remaining proof term after the initial lambdas.
collect : Tm -> (List (TTName, Ty), Tm)
collect (RBind n' (Lam b) t') with (collect t')
  | (xs, rest) = ((n', b) :: xs, rest)
collect t' = ([], t')

||| Returns a left and right hand side for a fun clause
lambdas : TTName -> Tm -> Elab (Tm, Tm)
lambdas n t =
    let (xs, rhs) = collect t in
    let apps = foldl (\t, (name, _) => RApp t (Var name)) (Var n) xs in
    let xsRev = reverse xs in
    pure (binds xsRev apps, binds xsRev rhs)
  where
    ||| The list should be reversed beforehand
    binds : List (TTName, Ty) -> Tm -> Raw
    binds [] t' = t'
    binds ((n', ty) :: xs) t' = binds xs $ RBind n' (PVar ty) t'

||| Takes a list of the arguments parsed by `collect`, and the rest of
||| the proof term. Checks how many consecutive `fst` and `snd` projections
||| in the beginning of `rest`. Returns a list of the names of the pairs they
||| project on, and what the projections are named. Also returns the rest
||| of the proof term stripped from the projections.
pairProjections : (lamIntro : List (TTName, Tm)) -> (rest : Tm)
               -> Elab (List (TTName, (TTName, TTName)), Tm)
pairProjections lamIntro rest =
  case rest of
    RBind n1 (Let a `(Prelude.Basics.fst {a=~a1} {b=~b1} ~(Var p1)))
      (RBind n2 (Let b `(Prelude.Basics.snd {a=~a2} {b=~b2} ~(Var p2))) t) =>
      if p1 == p2 && (p1 `elem` (fst <$> lamIntro)) && not (p1 `isBound` t)
         then do (xs, t') <- pairProjections lamIntro t
                 pure ((p1, (n1, n2)) :: xs, t)
         else pure ([], rest)
    RBind n b t =>
      if n `elem` (fst <$> lamIntro)
         then pure ([], rest)
         else do (xs, t') <- pairProjections lamIntro t
                 pure (xs, RBind n b t')
    RApp t1 t2 =>
      do (xs, t1') <- pairProjections lamIntro t1
         (ys, t2') <- pairProjections lamIntro t2
         pure (xs ++ ys, RApp t1' t2')
    _ => pure ([], rest)

||| The entry point for other modules.
definitionize : TTName -> Tm -> Elab (FunDefn Raw)
definitionize n t =
  let (lhs, rhs) = !(lambdas n t) in
  -- TODO figure out how to create LHS and RHS that respects the pair patterns
  -- let (pairReplacements, rest) = pairProjections _ rhs
  pure $ DefineFun n [MkFunClause lhs rhs]