module TypeTrans.AST

import Data.Vect

-- Define Type Aliases
Rule : Type
Rule = String

Name : Type
Name = String

Value : Type
Value = String

Assoc : Type
Assoc = Bool

Performance : Type
Performance = Float

Cost : Type
Cost = Float

data Variant = Par | Seq | Stream | Tree

implementation Show Variant where
  show Par = "Par"
  show Seq = "Seq"
  show Stream = "Stream"
  show Tree = "Tree"

data TypeT =
    Vec Nat TypeT |
    Tuple (List TypeT) |
    IntT |
    ByteT |
    BitT |
    LongT |
    FloatT |
    DoubleT |
    BoolT |
    T1 |
    T2 |
    T3

implementation Show TypeT where
  show (Vec i t) = "Vec " ++ show i ++ " (" ++ show t ++ ")"
  show (Tuple xs) = "Tuple " ++ show xs
  show IntT = "Int"
  show ByteT = "Byte"
  show BitT = "Bit"
  show LongT = "Long"
  show FloatT = "Float"
  show DoubleT = "Double"
  show BoolT = "Bool"
  show T1 = "T1"
  show T2 = "T2"
  show T3 = "T3"

-- Vector with description of its dimensions in the type
--NVec : Vect n Nat -> TypeT -> TypeT
--NVec Nil t = t
--NVec (v::vs) t = Vec v (NVec vs t)

-- Calculate the dimension of the given type
getDimension : TypeT -> Nat
getDimension (Vec i t) = (S Z) + getDimension t
getDimension _ = Z -- Non vector types have dimension 0

mutual
-- Argument is not a very good name. I mean something of type a as opposed to a -> b for the actions
  data Argument =
       Arg Name TypeT |
       Val Value TypeT |
       Res Action Argument |
       Let (List (Argument,Argument)) Argument --  let like this is not an action, it's only an action if I do  \x -> let ... x ... in ... i.e. Lambda x (let ...)

  implementation Show Argument where
    show (Arg n t) = "Arg " ++ n ++ " " ++ show t
    show (Val v t) = "Val " ++ v ++ " " ++ show t
    show (Res act arg) = "Res " ++ show act ++ " " ++ show arg
    show (Let xs arg) = "Let " ++ show xs ++ " " ++ show arg

  data Action =
      Opaque Name (List Argument) Argument TypeT (Performance,Cost) | -- [Type] is for constant args to map or fold, the first Type is the input arg, the last Type the return type
      OpaqueBin Assoc Name (List Argument) Argument Argument (Performance,Cost) |
      Map Variant Action |
      Fold Variant Action Argument | -- Argument here is the accumulator, and action must be a binary operation, not unary
      Compose (List Action) |
      -- Lambda (List Argument) (Action) ?
      Lambda (List Argument) Argument | -- (\(x,y) -> map (g x) y) becomes Lambda [x,y] (Map g x) y so the last Argument is usually a Res
      Loop Action Action |
      Split Int |
      Merge Int |
      Distr Int Int |
      Group (List (Argument, List Rule)) |
      Ungroup (List (Argument, List Rule)) |
      Zip (List TypeT) | -- this should really only work on a set of vectors and return a Vec (Tuple [Type]) Int
      Unzip TypeT  -- This should really only work on a Tuple [Vec Type Int]

  implementation Show Action where
    show (Opaque n xs arg t pc) = "Opaque " ++ n ++ " " ++ show xs ++ " " ++
                                  show arg ++ " "++ show t ++ " " ++ show pc
    show (OpaqueBin a n xs arg1 arg2 pc) = "Opaque " ++ show a ++ " " ++ n ++ " " ++
                                         show arg1 ++ " " ++ show arg2 ++ " " ++ show pc
    show (Map v act) = "Map " ++ show v ++ " " ++ show act
    show (Fold v act arg) = "Fold " ++ show v ++ " " ++ show act ++ " " ++ show arg
    show (Compose xs) = "Compose " ++ show xs
    show (Lambda xs act) = "Lambda " ++ show xs ++ " " ++ show act
    show (Loop act1 act2) = "Loop " ++  show act1 ++ " " ++ show act2
    show (Split i) = "Split " ++ show i
    show (Merge i) = "Merge " ++ show i
    show (Distr i1 i2) = "Distr " ++ show i1 ++ " " ++ show i2
    show (Group xs) = "Group " ++ show xs
    show (Ungroup xs) = "Ungroup " ++ show xs
    show (Zip xs) = "Zip " ++ show xs
    show (Unzip t) = "Unzip " ++ show t

-- We also need Zip, Unzip and Let
--data FoldAction =  deriving Show-- No need for return type as it's b -> a  -> b

data Program = Prog Action Argument  -- So actually Prog is identical to Res

implementation Show Program where
  show (Prog act arg) = "Prog " ++ show act ++ " " ++ show arg

-- I also need to represent a while-loop
-- We assume we have a loop primitive in the language
-- let loop cond action v  = (let res = action v in if (cond res) then res else loop cond action res)
-- This becomes Loop (Opaque "cond" [] (Arg "res" T2) BoolT) (Opaque "action" [] (Arg "v" T1))
-- and a way to extract values from a tuple, maybe a let?
{-

let
    (err, p', p_avg) = fold (0, [], 0) sor p
in
    map (stage3 p_avg) p'
    rather than simply (map stage3) $ (fold acc stage2) $ (map stage1) p
 this would be
 (\(v_in,stage1,stage2) -> let  (err, p', p_avg) = fold (0, [], 0) stage1 v_in in map (stage2 p_avg) p') $ map stage1 p
 The best way is to add a Lambda action

(\(x,y) -> map (g x) y) . (foldl f acc ) $ v -- [4,5,6]
-}

-- (Tuple [IntT,Vec IntT 3])
{-
p : Program
p = Prog  (Compose [
            Lambda [Arg "x" IntT, Arg "y" (Vec 3 IntT)]
                   (Map Seq (Opaque "g" [Arg "x" IntT] (Arg "a1" IntT) IntT (0,0)))
                   ]
          ) {- (Arg "y" (Vec IntT 3)),
        Fold Seq (OpaqueBin True "f" [] (Arg "acc" (Tuple [IntT,Vec IntT 3])) (Arg "a2" IntT) (0,0)) (Arg "acc" (Tuple [IntT,Vec IntT 3]))
        ])  -}
    (Arg "v" (Vec 3 IntT))

-}


module Libraries.Data.IMaybe

%default total

public export
data IMaybe : Bool -> Type -> Type where
  Nothing : IMaybe False a
  Just : a -> IMaybe True a

export
Functor (IMaybe b) where
  map f Nothing = Nothing
  map f (Just x) = Just (f x)

export
fromJust : IMaybe True a -> a
fromJust (Just x) = x


module VISD.Common

import Control.Isomorphism
import Data.BoundedList

%logging 1
%default total
%hide Prelude.Algebra.(<*>)
%hide Prelude.Applicative.(<|>)
%hide Prelude.Vect.reverse

-- http://www.informatik.uni-marburg.de/~rendel/unparse/

-- core definitions

data PartIso : Type -> Type -> Type where
  MkPartIso : (to : a -> Maybe b) ->
              (from : b -> Maybe a) ->
              (toFrom : (y : b) -> maybe () (\x => to x = Just y) (from y)) ->
              (fromTo : (x : a) -> maybe () (\y => from y = Just x) (to x)) ->
              PartIso a b

class PartIsoFunctor (f : Type -> Type -> Type) where
  (<$>) : PartIso a b -> f a c -> f b c

class PFunctor (f : Type -> Type -> Type) where
  (<*>) : f a c -> Lazy (f b c) -> f (a, b) c

class PAlternative (f : Type -> Type -> Type) where
  (<|>) : f a c -> Lazy (f a c) -> f a c
  empty : f a c

class (PartIsoFunctor d, PFunctor d, PAlternative d) => Syntax (d : Type -> Type -> Type) c where
  pure : Eq a => a -> d a c
  item : d c c

-- helper functions

ipc_inverse : PartIso a b -> PartIso b a
ipc_inverse (MkPartIso f g tf ft) = MkPartIso g f ft tf

ipc_apply : PartIso a b -> a -> Maybe b
ipc_apply (MkPartIso f g ft ft) = f

ipc_unapply : PartIso a b -> b -> Maybe a
ipc_unapply = ipc_apply . ipc_inverse

-- Inspect and other stuff

data Inspect : a -> Type where
  wi : {A : Type} -> (x : A) -> (y : A) -> (eq: x = y) -> Inspect x

inspect : {A : Type} -> (x : A) -> Inspect x
inspect x = wi x _ Refl

match : {A : Type} -> {x : A} -> (y : A) -> {eq : x = y} -> Inspect x
match y {eq} = wi _ y eq

maybe_assoc : (x : Maybe a) -> (f : a -> Maybe b) -> (g : b -> Maybe c) -> (x >>= (\y => f y >>= g)) = (x >>= f >>= g)
maybe_assoc Nothing f g = Refl
maybe_assoc (Just x) f g = Refl

maybe_unbind : (f : a -> Maybe b) -> (g : b -> Maybe c) -> (x : a) -> {y : b} ->
  (f x = Just y) -> g y = Just x >>= f >>= g
maybe_unbind f g x eq = rewrite eq in Refl

-- Algebra

infixr 1 >=>
(>=>) : Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
f >=> g = \x => f x >>= g

pId : PartIso a a
pId = MkPartIso (\x => Just x) (\x => Just x) (\x => Refl) (\x => Refl)

infixl 9 ..
(..) : PartIso b c -> PartIso a b -> PartIso a c
(MkPartIso gTo gFrom gTF gFT) .. (MkPartIso fTo fFrom fTF fFT) =
  MkPartIso
    (ipc_apply (MkPartIso fTo fFrom fTF fFT) >=> ipc_apply (MkPartIso gTo gFrom gTF gFT))
    (ipc_unapply (MkPartIso gTo gFrom gTF gFT) >=> ipc_unapply (MkPartIso fTo fFrom fTF fFT))
    tf ft
  where
    tf y with (inspect $ (gFrom y))
      | match Nothing {eq} = rewrite eq in ()
      | match (Just z) {eq} = rewrite eq in case (inspect $ fFrom z) of
        match Nothing {eq=eq1} => rewrite eq1 in ()
        match (Just n) {eq=eq1} => rewrite eq1 in
          rewrite (replace eq1 {P=(\pz => maybe () (\x => fTo x = Just z) pz)} (fTF z)) in
            (replace eq {P=(\py => maybe () (\x => gTo x = Just y) py)} (gTF y))
    ft x with (inspect $ (fTo x))
      | match Nothing {eq} = rewrite eq in ()
      | match (Just z) {eq} = rewrite eq in case (inspect $ gTo z) of
        match Nothing {eq=eq1} => rewrite eq1 in ()
        match (Just n) {eq=eq1} => rewrite eq1 in
          rewrite (replace eq1 {P=(\pz => maybe () (\x => gFrom x = Just z) pz)} (gFT z)) in
            (replace eq {P=(\py => maybe () (\y => fFrom y = Just x) py)} (fFT x))

commute : PartIso (a, b) (b, a)
commute = MkPartIso f f (\(a,b) => Refl) (\(a,b) => Refl) where
  f : (c, d) -> Maybe (d, c)
  f (a, b) = Just (b, a)

unit : {a : Type} -> PartIso a (a, ())
unit = MkPartIso f g tf ft where
  f : {a : Type} -> a -> Maybe (a, ())
  f a = Just (a, ())
  g : {a : Type} -> (a, ()) -> Maybe a
  g (a, ()) = Just a
  tf (a, ()) = Refl
  ft a = Refl

-- *>, <*

infixl 3 *>
(*>) : Syntax d c => d () c -> d a c -> d a c
p *> q = ipc_inverse unit .. commute <$> p <*> q

infixl 3 <*
(<*) : Syntax d c => d a c -> d () c -> d a c
p <* q = ipc_inverse unit <$> p <*> q

-- the following function can't be verified: there's no isomorphism
-- when we are ignoring input; neither can it be changed, because it's
-- quite important to be able to ignore input

ignore : a -> PartIso a ()
ignore x = MkPartIso f g tf ft where
  f : a -> Maybe ()
  f y = Just ()
  g : () -> Maybe a
  g () = Just x
  tf () = Refl
  ft y = believe_me (Just x = Just y)

-- Parser

data Parser a c = MkParser (List c -> Maybe (a, List c))

parse : Parser a c -> List c -> Maybe a
parse (MkParser p) s = p s >>= pure . fst

instance PartIsoFunctor Parser where
  iso <$> (MkParser p) = MkParser pf
  where
    pf l = do
      (x, rest) <- p l
      y <- ipc_apply iso x
      return (y, rest)

instance PFunctor Parser where
  (MkParser p) <*> mkpq = MkParser pf
  where
    pf l = do
      (x, rest) <- p l
      case mkpq of
        (MkParser q) => do
          (y, ret) <- q rest
          return ((x, y), ret)

instance PAlternative Parser where
  (MkParser p) <|> mkpq = MkParser pf
  where
    pf l = case p l of
      Just x => Just x
      Nothing => case mkpq of
        (MkParser q) => q l
  empty = MkParser (\s => Nothing)

instance Syntax Parser c where
  pure x = MkParser (\s => Just (x, s))
  item = MkParser f
  where
    f [] = Nothing
    f (x :: xs) = Just (x, xs)

-- Printer

data Printer a c = MkPrinter (a -> Maybe (List c))

compose : Printer a c -> a -> Maybe (List c)
compose (MkPrinter p) x = p x

instance PartIsoFunctor Printer where
  iso <$> (MkPrinter p) = MkPrinter (\b => ipc_unapply iso b >>= p)

instance PFunctor Printer where
  (MkPrinter p) <*> mkpq = MkPrinter pf
  where
    pf (x, y) = do
      x' <- p x
      case mkpq of
        (MkPrinter q) => do
          y' <- q y
          return (x' ++ y')

instance PAlternative Printer where
  (MkPrinter p) <|> mkpq = MkPrinter $ \s =>
    case (p s) of
      Nothing => case mkpq of
        (MkPrinter q) => q s
      x => x
  empty = MkPrinter (\s => Nothing)

instance Syntax Printer c where
  pure x = MkPrinter (\y =>
    if x == y
    then Just []
    else Nothing)
  item = MkPrinter (\t => Just [t])

-- Basic parsers/composers

sat : Syntax d a => (a -> Bool) -> d a a
sat {a} p = (MkPartIso check check verify verify) <$> item
  where
    check : a -> Maybe a
    check x = if p x then Just x else Nothing
    verify y with (inspect $ p y)
      | match False {eq=eq} = rewrite eq in ()
      | match True {eq=eq} = rewrite eq in
        rewrite eq in Refl

val : (Syntax d a, Eq a) => a -> d a a
val x = sat (== x)

-- rep

nilv : PartIso () (Vect 0 a)
nilv = MkPartIso to from tf ft
  where
    to : () -> Maybe (Vect 0 a)
    to () = Just $ Vect.Nil {a=a}
    from : (Vect 0 a) -> Maybe ()
    from [] = Just ()
    from _ = Nothing
    tf [] = Refl
    ft () = Refl

consv : PartIso (a, Vect n a) (Vect (S n) a)
consv = MkPartIso c1 c2 tf ft
  where
    c1 : (a, Vect n a) -> Maybe (Vect (S n) a)
    c1 (x, xs) = Just (x :: xs)
    c2 : (Vect (S n) a) -> Maybe (a, Vect n a)
    c2 (x :: xs) = Just (x, xs)
    tf (x :: xs) = Refl
    ft (a, b) = Refl

rep : Syntax d c => (n : Nat) -> d a c -> d (Vect n a) c
rep Z p = nilv <$> pure ()
rep (S k) p = consv <$> p <*> rep k p

-- up to

bNil : PartIso () (BoundedList n a)
bNil = MkPartIso to from tf ft
  where
    to : () -> Maybe (BoundedList n a)
    to () = Just []
    from : BoundedList n a -> Maybe ()
    from [] = Just ()
    from _ = Nothing
    tf [] = Refl
    tf (x::xs) impossible
    ft () = Refl

bCons : PartIso (a, BoundedList n a) (BoundedList (S n) a)
bCons = MkPartIso to from tf ft
  where
    to : (a, BoundedList n a) -> Maybe (BoundedList (S n) a)
    to (x, l) = Just $ x :: l
    from : BoundedList (S n) a -> Maybe (a, BoundedList n a)
    from [] = Nothing
    from (x :: xs) = Just (x, xs)
    tf [] = ()
    tf (x :: xs) = Refl
    ft (x, l) = Refl

upTo : Syntax d c => (n: Nat) -> d a c -> d (BoundedList n a) c
upTo Z _ = (bNil <$> pure ())
upTo (S n) p = (bCons <$> (p <*> (upTo n p)))
           <|> (bNil <$> pure ())

bounded : Syntax d c => (min,add: Nat) -> d a c -> d (Vect min a, BoundedList add a) c
bounded min add p = rep min p <*> upTo add p

-- maybe

just : PartIso a (Maybe a)
just = MkPartIso (Just . Just) id tf ft
  where
    tf Nothing = ()
    tf (Just x) = Refl
    ft _ = Refl

nothing : PartIso () (Maybe a)
nothing = MkPartIso to from tf ft
  where
    to : () -> Maybe (Maybe a)
    to x = Just Nothing
    from : Maybe a -> Maybe ()
    from (Just x) = Nothing
    from Nothing = Just ()
    tf (Just x) = ()
    tf Nothing = Refl
    ft () = Refl

maybe : Syntax d c => d a c -> d (Maybe a) c
maybe p = (just <$> p)
      <|> (nothing <$> pure ())

-- many

nil : PartIso () (List a)
nil = MkPartIso c1 c2 tf ft
  where
    c1 : () -> Maybe (List a)
    c1 () = Just []
    c2 : List a -> Maybe ()
    c2 [] = Just ()
    c2 (x :: xs) = Nothing
    tf [] = Refl
    tf (x :: xs) = ()
    ft () = Refl

cons : PartIso (a, List a) (List a)
cons = MkPartIso c1 c2 tf ft
  where
    c1 : (a, List a) -> Maybe (List a)
    c1 (x, l) = Just $ x :: l
    c2 : List a -> Maybe (a, List a)
    c2 [] = Nothing
    c2 (x :: xs) = Just (x, xs)
    tf [] = ()
    tf (x :: xs) = Refl
    ft (x, l) = Refl

partial many : Syntax d c => d a c -> d (List a) c
many p = (cons <$> (p <*> (many p)))
     <|> (nil <$> pure ())

-- sepBy1

partial sepBy1 : Syntax d c => d a c -> d b c -> b -> d (List a) c
sepBy1 p s x = cons <$> (p <*> (many ((ignore x <$> s) *> p)))


module Sub12Apply108x90

import ProofColDivSeqBase
import ProofColDivSeqPostulate

%default total
-- %language ElabReflection

-- 3(36x+30) --F[5,-2]->B[1,-2]--> 3(16x+13)
fb108x90To48x39 :
  (o:Nat) -> P (S (S (S (S (S (S (plus (plus (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                              (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                        (S (S (S (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))) (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))))))  (S (S (S (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                 (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))))))))))))))) 2
    -> P (S (S (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o))) (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o))))))))))))))))) 2
fb108x90To48x39 o prf =
  let prf2 = lvDown (S (S (S (S (S (S (plus (plus (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                              (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                        (S (S (S (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))) (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))))))  (S (S (S (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                 (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))))))))))))))) 2
                    prf in
    let prf3 = fb108x90To48x39' o prf2 in lvDown (S (S (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o))) (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o))))))))))))))))) 3 prf3

export
apply108x90 : P (S (S (S (S (S (S (plus (plus (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                              (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                        (S (S (S (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))) (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))))))  (S (S (S (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                 (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))))))))))))))) 2
  -> (m : Nat **
        (LTE (S m)
             (S (S (S (S (S (S (plus (plus (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                 (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                           (S (S (S (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                          (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))))))
                                     (S (S (S (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                    (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))))))))))))))),
         P m 2))
apply108x90 {o} col = let col2 = fb108x90To48x39 o col in ((S (S (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o))) (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o)))))))))))))))))
                                                           ** (lte108x90 o, col2)) where
  lte108x90 : (o:Nat) -> LTE (S (S (S (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o)))
                                                          (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o))))))))))))))))))
          (S (S (S (S (S (S (plus (plus (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                              (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                        (S (S (S (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))) (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))))))                                  (S (S (S (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                 (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))))))))))))
  lte108x90 Z = (lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc) LTEZero
  lte108x90 (S o) = let lemma = lte108x90 o in
    rewrite (sym (plusSuccRightSucc o o)) in
    rewrite (sym (plusSuccRightSucc (plus o o)  (S (plus o o)))) in
    rewrite (sym (plusSuccRightSucc (plus o o)  (plus o o))) in
    rewrite (sym (plusSuccRightSucc (plus (plus o o) (plus o o))  (S (S (S (plus (plus o o) (plus o o))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus o o) (plus o o))  (S (S (plus (plus o o) (plus o o)))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus o o) (plus o o))  (S (plus (plus o o) (plus o o))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus o o) (plus o o))  (plus (plus o o) (plus o o)))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o)))  (S (S (S (S (S (S (S (plus (plus (plus o o) (plus o o))
                                                            (plus (plus o o) (plus o o)))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o)))  (S (S (S (S (S (S (plus (plus (plus o o) (plus o o))
                                                            (plus (plus o o) (plus o o))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o)))  (S (S (S (S (S (plus (plus (plus o o) (plus o o))
                                                            (plus (plus o o) (plus o o)))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o)))  (S (S (S (S (plus (plus (plus o o) (plus o o))
                                                            (plus (plus o o) (plus o o))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o)))  (S (S (S (plus (plus (plus o o) (plus o o))
                                                            (plus (plus o o) (plus o o)))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o)))  (S (S (plus (plus (plus o o) (plus o o))
                                                            (plus (plus o o) (plus o o))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o)))  (S (plus (plus (plus o o) (plus o o))
                                                            (plus (plus o o) (plus o o)))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) (plus o o)) (plus (plus o o) (plus o o)))  (plus (plus (plus o o) (plus o o))
                                                            (plus (plus o o) (plus o o))))) in

    rewrite (sym (plusSuccRightSucc (plus o o)  o)) in

    rewrite (sym (plusSuccRightSucc (plus (plus o o) o)  (S (S (S (S (plus (plus o o) o))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus o o) o)  (S (S (S (plus (plus o o) o)))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus o o) o)  (S (S (plus (plus o o) o))))) in

    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))  (S (S (S (S (S (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))  (S (S (S (S (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))  (S (S (S (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))  (S (S (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))  (S (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))  (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))) in

    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o))))))))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o)))))))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o))))))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o)))))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o))))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o)))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o)))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o)))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus o o) o) (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o) (S (S (plus (plus o o) o)))))))
                                    (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o)
                                            o)))))))))))) in

    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o))))))))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o)))))))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o))))))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o)))))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o))))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (S (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o)))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o))))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o)))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o))))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o)))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o))))))))))))) in
    rewrite (sym (plusSuccRightSucc (plus (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))
                                                                                (S (S (S (plus (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o))))
                                                                                (S (S (plus (plus (plus o o) o)
                                                                                (S (S (plus (plus o o) o)))))))))))
                                    (S (S (S (plus (plus (plus (plus o
                                                                                o) o)
                                                                                (S (S (plus (plus o o)
                                                                                o))))
                                                                                (S (S (plus (plus (plus o o)
                                                                                o) (S (S (plus (plus o o)
    o)))))))))))) in
      (lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . lteSuccRight . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc . LTESucc) lemma


module Control.Linear.LState

import Control.Linear

%default total

export
data LState : (stateType : Type) -> (a : Type) -> Type where
  MkLState : (1 f : ((1 _ : stateType) -> (LPair a stateType))) -> LState stateType a

export
Functor (LState stateType) where
  map f (MkLState c) = MkLState (\s => let (r # s') = c s in ((f r) # s'))

export
Applicative (LState stateType) where
  pure x = MkLState (\s => x # s)
  (MkLState cf) <*> (MkLState cv) = MkLState (\s =>
                                    let (f # s') = cf s
                                        (r # s'') = cv s'
                                        in ((f r) # s''))

export
LMonad (LState s) where
  (>>=) (MkLState f) c = MkLState (\x => let (res # s') = f x in
                                                 let (MkLState r2) = c res
                                                      in r2 s')

export
run : (f : (1 state : s) -> (LPair a s)) -> LState s a
run f = MkLState f

export
change : (f : (1 state : s) -> s) -> LState s ()
change f = MkLState (\state => (() # f state))

public export
interface SubState a b where
  liftSt : LState a r -> LState b r

export
SubState a (a, b) where
  liftSt (MkLState f) = MkLState (\(sa, sb) => let (res # sa') = f sa in
                                                  (res # (sa', sb)))

export
SubState a (b, a) where
  liftSt (MkLState f) = MkLState (\(sb, sa) => let (res # sa') = f sa in
                                                  (res # (sb, sa')))

export
runLState : (1 initState : stateType) -> (1 c : LState stateType r) -> LPair r stateType
runLState s (MkLState f) = f s

export
execLState : (1 initState : stateType) -> (1 c : LState stateType r) -> stateType
execLState s (MkLState f) = let (_ # finState) = f s in finState


module Reviewer

import Data.Nat
import Data.String
import Data.List
import Data.List.DeleteBy
import Data.List1
import System.Random.Node
import Text.PrettyPrint.Prettyprinter
import Text.PrettyPrint.Prettyprinter.Symbols
import Text.PrettyPrint.Prettyprinter.Render.Terminal
import Util

%default total

record Score login where
  constructor MkScore
  user          : login
  partialScore  : Nat
  combinedScore : Nat

loginScore : Score login -> (login, Nat)
loginScore (MkScore l s c) = (l, c)

||| Get scored reviewers sorted from lowest to highest score.
||| A low score indicates less review work (a better candidate for
||| assigning a new PR to).
|||
||| The resulting `Score` contains both a partial score (the score
||| based only on open reivews) and also a combined score (the score
||| after negatively weighting closed reviews).
|||
||| Closed reviews are negatively scored because they are review requests
||| that were not answered.
scoredReviewers : Ord login =>
                  (closedReviews : List login)
               -> (openReviews : List login)
               -> (candidates : List login)
               -> List (Score login)
scoredReviewers closedReviews openReviews candidates =
  let closedReviewsWeighted = weightReviews 1 closedReviews
      openReviewsWeighted   = weightReviews 4 openReviews
      allReviews            = zipReviews openReviewsWeighted closedReviewsWeighted Subtract False
  in sort' $ zipReviews allReviews (weightReviews 0 candidates) Add True
  where
      -- The number of appearances is multiplied by the supplied weight which
      -- allows us to weight some lists more heavily than others.
      weightReviews : (weight : Nat) -> List login -> List (Score login)
      weightReviews weight reviews =
        let grouped = groupAllWith id reviews
        in  grouped <&> (\xs => let score = (* weight) . length $ forget xs in (MkScore (head xs) score score))

      -- Sort logins by the number of times each login was requested for review.
      sort' : List (Score login) -> List (Score login)
      sort' = sortBy $ compare `on` combinedScore

      data Op = Add | Subtract

      -- Add or subtract the scores for any equal logins.
      -- If `filterToSecondList` then no elements in the first list
      -- but not the second list will be kept.
      zipReviews : List (Score login) -> List (Score login) -> Op -> (filterToSecondList : Bool) -> List (Score login)
      zipReviews [] [] _ _     = []
      zipReviews [] ys Add _   = ys
      zipReviews [] ys Subtract _ = { combinedScore := 0 } <$> ys
      zipReviews xs [] _ True  = []
      zipReviews xs [] _ False = xs
      zipReviews (x@(MkScore l1 s1 c1) :: xs) ys op filter =
        case (deleteBy' ((==) `on` user) x ys, filter) of
             ((Nothing      , ys'), False)      => (MkScore l1 s1 c1             ) :: zipReviews xs ys' op filter
             ((Nothing      , ys'), True )      =>                                    zipReviews xs ys' op filter
             ((Just (MkScore _ _ c2'), ys'), _) => (MkScore l1 s1 (c1 `calc` c2')) :: zipReviews xs ys' op filter
        where
          calc : Nat -> Nat -> Nat
          calc k j with (op)
            _ | Add      = k + j
            _ | Subtract = k `minus` j

||| Choose reviewers that maintain harmony in the review world.
||| Returns the logins of all reviewers that would work equally well.
|||
||| @ closedReviews   The logins of each reviewer of each closed PR (duplicates intact).
||| @ openReviews     The logins of each reviewer of each open PR (duplicates intact).
||| @ candidates      The logins of all potential reviewers that should be considered.
||| @ forcedReviewers The logins of all reviewers that are being forced (not chosen by harmony).
||| @ author          The author of the PR for which a reviewer is being picked.
export
chooseReviewers : Ord login =>
                  (closedReviews : List login)
               -> (openReviews : List login)
               -> (candidates : List login)
               -> (forcedReviewers : List login)
               -> (author : login)
               -> List (login, Nat)
chooseReviewers closedReviews openReviews candidates forcedReviewers author =
  let remainingOptions = (nub candidates) \\ (author :: forcedReviewers)
      scoredOptions    = scoredReviewers closedReviews openReviews remainingOptions
  in  case scoredOptions of
           [] => []
           ((MkScore l s c) :: xs) =>
             let rest  = takeWhile ((== c) . combinedScore) xs
                 rest' = loginScore <$> rest
             in  (l, c) :: rest'

export
randomReviewer : HasIO io => List (login, Nat) -> io (Maybe login)
randomReviewer [] = pure Nothing
randomReviewer (x :: xs) = (Just . fst) <$> rndSelect (x :: xs)

||| Produce a graph of relative review workload for all developers matching the given
||| filter.
||| @ closedReviews The logins of each reviewer of each closed PR (duplicates intact).
||| @ openReviews   The logins of each reviewer of each open PR (duplicates intact).
||| @ candidates    The logins of all potential reviewers that should be considered.
export
reviewsGraph : Ord login => Pretty login =>
               (closedReviews : List login)
            -> (openReviews : List login)
            -> (candidates : List login)
            -> Doc AnsiStyle
reviewsGraph closedReviews openReviews candidates =
  let scoredOptions = reverse $ scoredReviewers closedReviews openReviews (sort $ nub candidates)
  in  case scoredOptions of
           [] => emptyDoc
           ((MkScore _ s c) :: _) =>
             let highScore = c + (s `minus` c)
             in  header <+> graph (if highScore > 0 then highScore else 1) scoredOptions <+> line
  where
    yellowDot : Doc AnsiStyle
    yellowDot = annotate (color Yellow) "·"

    redDot : Doc AnsiStyle
    redDot = annotate (color Red) "◦"

    header : Doc AnsiStyle
    header = vsep [ emptyDoc
                  , pretty "Weighted review workload."
                  , pretty "4x the numbewr of open review requests" <++> parens yellowDot
                  , pretty "1x the number of closed PRs with unanswered review requests" <++> parens redDot
                  , parens $ redDot <++> pretty "overlayed on" <++> yellowDot
                  , emptyDoc
                  , emptyDoc
                  ]

    -- The "detractor" is an indication of the amount of the score that was taken
    -- away by the heuristic in `scoredReviewers` that weights closed reviews with
    -- unanswered review requests negatively.
    bar : (indentation : Nat) -> (score : Nat) -> (detractor : Nat) -> Doc AnsiStyle
    bar idt score detractor = indent (cast idt) . hcat $
                                [ annotate (color Red) . pretty $ replicate detractor '◦'
                                , annotate (color Yellow) . pretty $ replicate score '·'
                                ]

    graphOne : (highScore : Nat) -> (Score login) -> Doc AnsiStyle
    graphOne highScore (MkScore user partialScore combinedScore) =
      let idt    = highScore `minus` partialScore
          user   = annotate italic $ pretty user
          detractor = (partialScore `minus` combinedScore)
          remainingSpace = highScore `minus` combinedScore
          -- we create a bar with the combinedScore and then fill in any
          -- remaining space with an indication of the detractor. We cap
          -- the detractor representation at the high score to make everything
          -- line up nicely. The detractor is just there to give some indication
          -- of review requests that did not count positively toward the score.
      in  bar idt combinedScore (min remainingSpace detractor) <++> user

    graph : (highScore : Nat) -> List (Score login) -> Doc AnsiStyle
    graph highScore = vsep . map (graphOne highScore)


module Lens.Reversible

import Data.Maybe
import Lens
import Lens.Uninhabited
import Lens.Util
import Map

%default total

make_reversible : (k : Kind) ->
    (s : Schema) -> (s' : Schema) ->
    transform_schema (Make k) s = Just s' -> transform_schema (reverse_lens (Make k)) s' = Just s
make_reversible KNull SNull _ Refl impossible
make_reversible KNull SBoolean _ Refl impossible
make_reversible KNull SNumber _ Refl impossible
make_reversible KNull SText _ Refl impossible
make_reversible KNull (SArray _ _) _ Refl impossible
make_reversible KNull (SObject _) _ Refl impossible
make_reversible (KPrimitive KBoolean) SNull SBoolean Refl = Refl
make_reversible (KPrimitive KBoolean) SBoolean _ Refl impossible
make_reversible (KPrimitive KBoolean) SNumber _ Refl impossible
make_reversible (KPrimitive KBoolean) SText _ Refl impossible
make_reversible (KPrimitive KBoolean) (SArray _ _) _ Refl impossible
make_reversible (KPrimitive KBoolean) (SObject _) _ Refl impossible
make_reversible (KPrimitive KNumber) SNull SNumber Refl = Refl
make_reversible (KPrimitive KNumber) SBoolean _ Refl impossible
make_reversible (KPrimitive KNumber) SNumber _ Refl impossible
make_reversible (KPrimitive KNumber) SText _ Refl impossible
make_reversible (KPrimitive KNumber) (SArray _ _) _ Refl impossible
make_reversible (KPrimitive KNumber) (SObject _) _ Refl impossible
make_reversible (KPrimitive KText) SNull SText Refl = Refl
make_reversible (KPrimitive KText) SBoolean _ Refl impossible
make_reversible (KPrimitive KText) SNumber _ Refl impossible
make_reversible (KPrimitive KText) SText _ Refl impossible
make_reversible (KPrimitive KText) (SArray _ _) _ Refl impossible
make_reversible (KPrimitive KText) (SObject _) _ Refl impossible
make_reversible KArray SNull (SArray True SNull) Refl = Refl
make_reversible KArray SBoolean _ Refl impossible
make_reversible KArray SNumber _ Refl impossible
make_reversible KArray SText _ Refl impossible
make_reversible KArray (SArray _ _) _ Refl impossible
make_reversible KArray (SObject _) _ Refl impossible
make_reversible KObject SNull (SObject Empty) Refl = Refl
make_reversible KObject SBoolean _ Refl impossible
make_reversible KObject SNumber _ Refl impossible
make_reversible KObject SText _ Refl impossible
make_reversible KObject (SArray _ _) _ Refl impossible
make_reversible KObject (SObject _) _ Refl impossible

destroy_reversible : (k : Kind) ->
    (s : Schema) -> (s' : Schema) ->
    transform_schema (Destroy k) s = Just s' -> transform_schema (reverse_lens (Destroy k)) s' = Just s
destroy_reversible KNull SNull _ Refl impossible
destroy_reversible KNull SBoolean _ Refl impossible
destroy_reversible KNull SNumber _ Refl impossible
destroy_reversible KNull SText _ Refl impossible
destroy_reversible KNull (SArray _ _) _ Refl impossible
destroy_reversible KNull (SObject _) _ Refl impossible
destroy_reversible (KPrimitive KBoolean) SNull _ Refl impossible
destroy_reversible (KPrimitive KBoolean) SBoolean SNull Refl = Refl
destroy_reversible (KPrimitive KBoolean) SNumber _ Refl impossible
destroy_reversible (KPrimitive KBoolean) SText _ Refl impossible
destroy_reversible (KPrimitive KBoolean) (SArray _ _) _ Refl impossible
destroy_reversible (KPrimitive KBoolean) (SObject _) _ Refl impossible
destroy_reversible (KPrimitive KNumber) SNull _ Refl impossible
destroy_reversible (KPrimitive KNumber) SBoolean _ Refl impossible
destroy_reversible (KPrimitive KNumber) SNumber SNull Refl = Refl
destroy_reversible (KPrimitive KNumber) SText _ Refl impossible
destroy_reversible (KPrimitive KNumber) (SArray _ _) _ Refl impossible
destroy_reversible (KPrimitive KNumber) (SObject _) _ Refl impossible
destroy_reversible (KPrimitive KText) SNull _ Refl impossible
destroy_reversible (KPrimitive KText) SBoolean _ Refl impossible
destroy_reversible (KPrimitive KText) SNumber _ Refl impossible
destroy_reversible (KPrimitive KText) SText SNull Refl = Refl
destroy_reversible (KPrimitive KText) (SArray _ _) _ Refl impossible
destroy_reversible (KPrimitive KText) (SObject _) _ Refl impossible
destroy_reversible KArray SNull _ Refl impossible
destroy_reversible KArray SBoolean _ Refl impossible
destroy_reversible KArray SNumber _ Refl impossible
destroy_reversible KArray SText _ Refl impossible
destroy_reversible KArray (SArray False _) _ Refl impossible
destroy_reversible KArray (SArray True SNull) SNull Refl = Refl
destroy_reversible KArray (SArray True SBoolean) _ Refl impossible
destroy_reversible KArray (SArray True SNumber) _ Refl impossible
destroy_reversible KArray (SArray True SText) _ Refl impossible
destroy_reversible KArray (SArray True (SArray _ _)) _ Refl impossible
destroy_reversible KArray (SArray True (SObject _)) _ Refl impossible
destroy_reversible KArray (SObject _) _ Refl impossible
destroy_reversible KObject SNull _ Refl impossible
destroy_reversible KObject SBoolean _ Refl impossible
destroy_reversible KObject SNumber _ Refl impossible
destroy_reversible KObject SText _ Refl impossible
destroy_reversible KObject (SArray _ _) _ Refl impossible
destroy_reversible KObject (SObject (Update _ _ _)) _ Refl impossible
destroy_reversible KObject (SObject Empty) s' prf =
    rewrite sym $ justInjective prf in Refl

add_property_reversible : (k : Key) ->
    (s : Schema) -> (s' : Schema) ->
    transform_schema (AddProperty k) s = Just s' -> transform_schema (reverse_lens (AddProperty k)) s' = Just s
add_property_reversible _ SNull _ Refl impossible
add_property_reversible _ SBoolean _ Refl impossible
add_property_reversible _ SNumber _ Refl impossible
add_property_reversible _ SText _ Refl impossible
add_property_reversible _ (SArray _ _) _ Refl impossible
add_property_reversible k (SObject m) s' prf with (get k m) proof prf1
    add_property_reversible k (SObject _) _ prf | (Just _) = absurd $ prf
    add_property_reversible k (SObject m) s' prf | Nothing =
        rewrite sym $ justInjective prf in
        rewrite update_eq m k (Just SNull) in
        rewrite update_shadow m k (Just SNull) Nothing in
        rewrite update_same m k Nothing prf1 in Refl

remove_property_reversible : (k : Key) ->
    (s : Schema) -> (s' : Schema) ->
    transform_schema (RemoveProperty k) s = Just s' -> transform_schema (reverse_lens (RemoveProperty k)) s' = Just s
remove_property_reversible _ SNull _ Refl impossible
remove_property_reversible _ SBoolean _ Refl impossible
remove_property_reversible _ SNumber _ Refl impossible
remove_property_reversible _ SText _ Refl impossible
remove_property_reversible _ (SArray _ _) _ Refl impossible
remove_property_reversible k (SObject m) s' prf with (get k m) proof prf1
    remove_property_reversible _ (SObject _) _ prf | Nothing = absurd $ prf
    remove_property_reversible _ (SObject _) _ prf | (Just SBoolean) = absurd $ prf
    remove_property_reversible _ (SObject _) _ prf | (Just SNumber) = absurd $ prf
    remove_property_reversible _ (SObject _) _ prf | (Just SText) = absurd $ prf
    remove_property_reversible _ (SObject _) _ prf | (Just (SArray _ _)) = absurd $ prf
    remove_property_reversible _ (SObject _) _ prf | (Just (SObject _)) = absurd $ prf
    remove_property_reversible k (SObject m) s' prf | (Just SNull) =
        rewrite sym $ justInjective prf in
        rewrite update_eq m k Nothing in
        rewrite update_shadow m k Nothing (Just SNull) in
        rewrite update_same m k (Just SNull) prf1 in Refl

rename_property_reversible : (k, k' : Key) ->
    (s : Schema) -> (s' : Schema) ->
    transform_schema (RenameProperty k k') s = Just s' -> transform_schema (reverse_lens (RenameProperty k k')) s' = Just s
rename_property_reversible _ _ SNull _ Refl impossible
rename_property_reversible _ _ SBoolean _ Refl impossible
rename_property_reversible _ _ SNumber _ Refl impossible
rename_property_reversible _ _ SText _ Refl impossible
rename_property_reversible _ _ (SArray _ _) _ Refl impossible
rename_property_reversible k k' (SObject m) s' prf with (get k m, get k' m) proof prf1
    rename_property_reversible _ _ (SObject _) _ prf | (Nothing, _) = absurd $ prf
    rename_property_reversible _ _ (SObject _) _ prf | (Just _, Just _) = absurd $ prf
    rename_property_reversible k k' (SObject m) s' prf | ((Just x), Nothing) =
        rewrite sym $ justInjective prf in
        rewrite update_eq (update k Nothing m) k' (Just x) in
        let va = cong fst prf1
            vb = cong snd prf1
            not_a_eq_b = get_neq $ tuple_eq prf1 uninhabited
            not_b_eq_a = \p => not_a_eq_b $ sym p in
        rewrite update_permute m k' k (Just x) Nothing not_b_eq_a in
        rewrite ne_key k k' not_a_eq_b in
        rewrite beq_key k in
        rewrite update_permute m k k' Nothing (Just x) not_a_eq_b in
        rewrite update_shadow (update k Nothing m) k' (Just x) Nothing in
        rewrite update_permute m k' k Nothing Nothing not_b_eq_a in
        rewrite update_same m k' Nothing vb in
        rewrite update_shadow m k Nothing (Just x) in
        rewrite update_same m k (Just x) va in Refl

hoist_property_reversible : (h, t : Key) ->
    (s : Schema) -> (s' : Schema) ->
    transform_schema (HoistProperty h t) s = Just s' -> transform_schema (reverse_lens (HoistProperty h t)) s' = Just s
hoist_property_reversible _ _ SNull _ Refl impossible
hoist_property_reversible _ _ SBoolean _ Refl impossible
hoist_property_reversible _ _ SNumber _ Refl impossible
hoist_property_reversible _ _ SText _ Refl impossible
hoist_property_reversible _ _ (SArray _ _) _ Refl impossible
hoist_property_reversible h t (SObject m) s' prf with (get h m, get t m) proof prf1
    hoist_property_reversible _ _ (SObject _) _ prf | (Nothing, _) = absurd $ prf
    hoist_property_reversible _ _ (SObject _) _ prf | (Just SNull, _) = absurd $ prf
    hoist_property_reversible _ _ (SObject _) _ prf | (Just SBoolean, _) = absurd $ prf
    hoist_property_reversible _ _ (SObject _) _ prf | (Just SNumber, _) = absurd $ prf
    hoist_property_reversible _ _ (SObject _) _ prf | (Just SText, _) = absurd $ prf
    hoist_property_reversible _ _ (SObject _) _ prf | (Just (SArray _ _), _) = absurd $ prf
    hoist_property_reversible _ _ (SObject _) _ prf | (Just (SObject _), Just _) = absurd $ prf
    hoist_property_reversible h t (SObject m) s' prf | (Just (SObject hm), Nothing) with (get t hm) proof prf2
        hoist_property_reversible _ _ (SObject _) _ prf | (Just (SObject _), Nothing) | Nothing = absurd $ prf
        hoist_property_reversible h t (SObject m) s' prf | (Just (SObject hm), Nothing) | Just x =
            rewrite sym $ justInjective prf in
            let neq_ht = get_neq (tuple_eq prf1 uninhabited)
                neq_th = \p => neq_ht (sym p) in
            rewrite update_permute m h t (Just (SObject (update t Nothing hm))) (Just x) neq_ht in
            rewrite ne_key t h neq_th in
            rewrite beq_key t in
            rewrite beq_key h in
            rewrite beq_key t in
            rewrite update_permute m t h (Just x) (Just (SObject (update t Nothing hm))) neq_th in
            rewrite update_shadow hm t Nothing (Just x) in
            rewrite update_permute (update t (Just x) m) t h Nothing (Just (SObject (update t Nothing hm))) neq_th in
            rewrite update_shadow m t (Just x) Nothing in
            rewrite update_shadow (update t Nothing m) h
                (Just (SObject (update t Nothing hm)))
                (Just (SObject (update t (Just x) hm))) in
            rewrite update_same m t Nothing (cong snd prf1) in
            rewrite update_same hm t (Just x) prf2 in
            rewrite update_same m h (Just (SObject hm)) (cong fst prf1) in Refl

plunge_property_reversible : (h, t : Key) ->
    (s : Schema) -> (s' : Schema) ->
    transform_schema (PlungeProperty h t) s = Just s' -> transform_schema (reverse_lens (PlungeProperty h t)) s' = Just s
plunge_property_reversible _ _ SNull _ Refl impossible
plunge_property_reversible _ _ SBoolean _ Refl impossible
plunge_property_reversible _ _ SNumber _ Refl impossible
plunge_property_reversible _ _ SText _ Refl impossible
plunge_property_reversible _ _ (SArray _ _) _ Refl impossible
plunge_property_reversible h t (SObject m) s' prf with (get t m, get h m, t == h) proof prf1
    plunge_property_reversible _ _ (SObject _) _ prf | (Nothing, _, _) = absurd $ prf
    plunge_property_reversible _ _ (SObject _) _ prf | (Just _, Nothing, _) = absurd $ prf
    plunge_property_reversible _ _ (SObject _) _ prf | (Just _, Just SNull, _) = absurd $ prf
    plunge_property_reversible _ _ (SObject _) _ prf | (Just _, Just SBoolean, _) = absurd $ prf
    plunge_property_reversible _ _ (SObject _) _ prf | (Just _, Just SNumber, _) = absurd $ prf
    plunge_property_reversible _ _ (SObject _) _ prf | (Just _, Just SText, _) = absurd $ prf
    plunge_property_reversible _ _ (SObject _) _ prf | (Just _, Just (SArray _ _), _) = absurd $ prf
    plunge_property_reversible _ _ (SObject _) _ prf | (Just _, Just (SObject _), True) = absurd $ prf
    plunge_property_reversible h t (SObject m) s' prf | (Just tv, Just (SObject hm), False) with (get t hm) proof prf2
        plunge_property_reversible _ _ (SObject _) _ prf | (Just _, Just (SObject _), False) | Just _ = absurd $ prf
        plunge_property_reversible h t (SObject m) s' prf | (Just tv, Just (SObject hm), False) | Nothing =
            rewrite sym $ justInjective prf in
            let neq_th = bne_key t h $ cong snd $ cong snd $ prf1
                neq_ht = \p => neq_th $ sym p in
            rewrite update_eq (update t Nothing m) h (Just (SObject (update t (Just tv) hm))) in
            rewrite update_permute m h t (Just (SObject (update t (Just tv) hm))) Nothing neq_ht in
            rewrite ne_key t h neq_th in
            rewrite beq_key t in
            rewrite beq_key t in
            rewrite update_shadow hm t (Just tv) Nothing in
            rewrite update_shadow (update h (Just (SObject (update t (Just tv) hm))) m) t Nothing (Just tv) in
            rewrite update_permute m t h (Just tv) (Just (SObject (update t (Just tv) hm))) neq_th in
            rewrite update_same m t (Just tv) (cong fst prf1) in
            rewrite update_shadow m h (Just (SObject (update t (Just tv) hm))) (Just (SObject (update t Nothing hm))) in
            rewrite update_same hm t Nothing prf2 in
            rewrite update_same m h (Just (SObject hm)) (cong fst $ cong snd prf1) in Refl

wrap_reversible :
    (s : Schema) -> (s' : Schema) ->
    transform_schema Wrap s = Just s' -> transform_schema (reverse_lens Wrap) s' = Just s
wrap_reversible SNull _ prf = rewrite sym $ justInjective prf in Refl
wrap_reversible SBoolean _ prf = rewrite sym $ justInjective prf in Refl
wrap_reversible SNumber _ prf = rewrite sym $ justInjective prf in Refl
wrap_reversible SText _ prf = rewrite sym $ justInjective prf in Refl
wrap_reversible (SArray _ _) _ prf = rewrite sym $ justInjective prf in Refl
wrap_reversible (SObject _) _ prf = rewrite sym $ justInjective prf in Refl

head_reversible :
    (s : Schema) -> (s' : Schema) ->
    transform_schema Head s = Just s' -> transform_schema (reverse_lens Head) s' = Just s
head_reversible SNull _ Refl impossible
head_reversible SBoolean _ Refl impossible
head_reversible SNumber _ Refl impossible
head_reversible SText _ Refl impossible
head_reversible (SArray False _) _ prf = rewrite sym $ justInjective prf in Refl
head_reversible (SArray True _) _ Refl impossible
head_reversible (SObject _) _ Refl impossible

convert_reversible : (k, k' : PrimitiveKind) -> (m : List (PrimitiveValue, PrimitiveValue)) ->
    (s : Schema) -> (s' : Schema) ->
    transform_schema (Convert k k' m) s = Just s' -> transform_schema (reverse_lens (Convert k k' m)) s' = Just s
convert_reversible k k' m s s' prf with (validate_map k k' m) proof prf1
    convert_reversible KBoolean KBoolean _ _ _ prf | False = absurd $ prf
    convert_reversible KBoolean KNumber _ _ _ prf | False = absurd $ prf
    convert_reversible KBoolean KText _ _ _ prf | False = absurd $ prf
    convert_reversible KNumber KBoolean _ _ _ prf | False = absurd $ prf
    convert_reversible KNumber KNumber _ _ _ prf | False = absurd $ prf
    convert_reversible KNumber KText _ _ _ prf | False = absurd $ prf
    convert_reversible KText KBoolean _ _ _ prf | False = absurd $ prf
    convert_reversible KText KNumber _ _ _ prf | False = absurd $ prf
    convert_reversible KText KText _ _ _ prf | False = absurd $ prf
    convert_reversible KBoolean KBoolean _ SNull _ prf | True = absurd $ prf
    convert_reversible KBoolean KBoolean _ SBoolean SNull prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KBoolean m SBoolean SBoolean prf | True =
        rewrite sym $ justInjective prf in
        rewrite flip_map_preserves_validity KBoolean KBoolean m prf1 in Refl
    convert_reversible KBoolean KBoolean _ SBoolean SNumber prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KBoolean _ SBoolean SText prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KBoolean _ SBoolean (SArray _ _) prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KBoolean _ SBoolean (SObject _) prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KBoolean _ SNumber _ prf | True = absurd $ prf
    convert_reversible KBoolean KBoolean _ SText _ prf | True = absurd $ prf
    convert_reversible KBoolean KBoolean _ (SArray _ _) _ prf | True = absurd $ prf
    convert_reversible KBoolean KBoolean _ (SObject _) _ prf | True = absurd $ prf
    convert_reversible KBoolean KNumber _ SNull _ prf | True = absurd $ prf
    convert_reversible KBoolean KNumber _ SBoolean SNull prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KNumber _ SBoolean SBoolean prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KNumber m SBoolean SNumber prf | True =
        rewrite sym $ justInjective prf in
        rewrite flip_map_preserves_validity KBoolean KNumber m prf1 in Refl
    convert_reversible KBoolean KNumber _ SBoolean SText prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KNumber _ SBoolean (SArray _ _) prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KNumber _ SBoolean (SObject _) prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KNumber _ SNumber _ prf | True = absurd $ prf
    convert_reversible KBoolean KNumber _ SText _ prf | True = absurd $ prf
    convert_reversible KBoolean KNumber _ (SArray _ _) _ prf | True = absurd $ prf
    convert_reversible KBoolean KNumber _ (SObject _) _ prf | True = absurd $ prf
    convert_reversible KBoolean KText _ SNull _ prf | True = absurd $ prf
    convert_reversible KBoolean KText _ SBoolean SNull prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KText _ SBoolean SBoolean prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KText _ SBoolean SNumber prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KText m SBoolean SText prf | True =
        rewrite sym $ justInjective prf in
        rewrite flip_map_preserves_validity KBoolean KText m prf1 in Refl
    convert_reversible KBoolean KText _ SBoolean (SArray _ _) prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KText _ SBoolean (SObject _) prf | True = absurd $ justInjective prf
    convert_reversible KBoolean KText _ SNumber _ prf | True = absurd $ prf
    convert_reversible KBoolean KText _ SText _ prf | True = absurd $ prf
    convert_reversible KBoolean KText _ (SArray _ _) _ prf | True = absurd $ prf
    convert_reversible KBoolean KText _ (SObject _) _ prf | True = absurd $ prf
    convert_reversible KNumber KBoolean _ SNull _ prf | True = absurd $ prf
    convert_reversible KNumber KBoolean _ SBoolean _ prf | True = absurd $ prf
    convert_reversible KNumber KBoolean _ SNumber SNull prf | True = absurd $ justInjective prf
    convert_reversible KNumber KBoolean m SNumber SBoolean prf | True =
        rewrite sym $ justInjective prf in
        rewrite flip_map_preserves_validity KNumber KBoolean m prf1 in Refl
    convert_reversible KNumber KBoolean _ SNumber SNumber prf | True = absurd $ justInjective prf
    convert_reversible KNumber KBoolean _ SNumber SText prf | True = absurd $ justInjective prf
    convert_reversible KNumber KBoolean _ SNumber (SArray _ _) prf | True = absurd $ justInjective prf
    convert_reversible KNumber KBoolean _ SNumber (SObject _) prf | True = absurd $ justInjective prf
    convert_reversible KNumber KBoolean _ SText _ prf | True = absurd $ prf
    convert_reversible KNumber KBoolean _ (SArray _ _) _ prf | True = absurd $ prf
    convert_reversible KNumber KBoolean _ (SObject _) _ prf | True = absurd $ prf
    convert_reversible KNumber KNumber _ SNull _ prf | True = absurd $ prf
    convert_reversible KNumber KNumber _ SBoolean _ prf | True = absurd $ prf
    convert_reversible KNumber KNumber _ SNumber SNull prf | True = absurd $ justInjective prf
    convert_reversible KNumber KNumber _ SNumber SBoolean prf | True = absurd $ justInjective prf
    convert_reversible KNumber KNumber m SNumber SNumber prf | True =
        rewrite sym $ justInjective prf in
        rewrite flip_map_preserves_validity KNumber KNumber m prf1 in Refl
    convert_reversible KNumber KNumber _ SNumber SText prf | True = absurd $ justInjective prf
    convert_reversible KNumber KNumber _ SNumber (SArray _ _) prf | True = absurd $ justInjective prf
    convert_reversible KNumber KNumber _ SNumber (SObject _) prf | True = absurd $ justInjective prf
    convert_reversible KNumber KNumber _ SText _ prf | True = absurd $ prf
    convert_reversible KNumber KNumber _ (SArray _ _) _ prf | True = absurd $ prf
    convert_reversible KNumber KNumber _ (SObject _) _ prf | True = absurd $ prf
    convert_reversible KNumber KText _ SNull _ prf | True = absurd $ prf
    convert_reversible KNumber KText _ SBoolean _ prf | True = absurd $ prf
    convert_reversible KNumber KText _ SNumber SNull prf | True = absurd $ justInjective prf
    convert_reversible KNumber KText _ SNumber SBoolean prf | True = absurd $ justInjective prf
    convert_reversible KNumber KText _ SNumber SNumber prf | True = absurd $ justInjective prf
    convert_reversible KNumber KText m SNumber SText prf | True =
        rewrite sym $ justInjective prf in
        rewrite flip_map_preserves_validity KNumber KText m prf1 in Refl
    convert_reversible KNumber KText _ SNumber (SArray _ _) prf | True = absurd $ justInjective prf
    convert_reversible KNumber KText _ SNumber (SObject _) prf | True = absurd $ justInjective prf
    convert_reversible KNumber KText _ SText _ prf | True = absurd $ prf
    convert_reversible KNumber KText _ (SArray _ _) _ prf | True = absurd $ prf
    convert_reversible KNumber KText _ (SObject _) _ prf | True = absurd $ prf
    convert_reversible KText KBoolean _ SNull _ prf | True = absurd $ prf
    convert_reversible KText KBoolean _ SBoolean _ prf | True = absurd $ prf
    convert_reversible KText KBoolean _ SNumber _ prf | True = absurd $ prf
    convert_reversible KText KBoolean _ SText SNull prf | True = absurd $ justInjective prf
    convert_reversible KText KBoolean m SText SBoolean prf | True =
        rewrite sym $ justInjective prf in
        rewrite flip_map_preserves_validity KText KBoolean m prf1 in Refl
    convert_reversible KText KBoolean _ SText SNumber prf | True = absurd $ justInjective prf
    convert_reversible KText KBoolean _ SText SText prf | True = absurd $ justInjective prf
    convert_reversible KText KBoolean _ SText (SArray _ _) prf | True = absurd $ justInjective prf
    convert_reversible KText KBoolean _ SText (SObject _) prf | True = absurd $ justInjective prf
    convert_reversible KText KBoolean _ (SArray _ _) _ prf | True = absurd $ prf
    convert_reversible KText KBoolean _ (SObject _) _ prf | True = absurd $ prf
    convert_reversible KText KNumber _ SNull _ prf | True = absurd $ prf
    convert_reversible KText KNumber _ SBoolean _ prf | True = absurd $ prf
    convert_reversible KText KNumber _ SNumber _ prf | True = absurd $ prf
    convert_reversible KText KNumber _ SText SNull prf | True = absurd $ justInjective prf
    convert_reversible KText KNumber _ SText SBoolean prf | True = absurd $ justInjective prf
    convert_reversible KText KNumber m SText SNumber prf | True =
        rewrite sym $ justInjective prf in
        rewrite flip_map_preserves_validity KText KNumber m prf1 in Refl
    convert_reversible KText KNumber _ SText SText prf | True = absurd $ justInjective prf
    convert_reversible KText KNumber _ SText (SArray _ _) prf | True = absurd $ justInjective prf
    convert_reversible KText KNumber _ SText (SObject _) prf | True = absurd $ justInjective prf
    convert_reversible KText KNumber _ (SArray _ _) _ prf | True = absurd $ prf
    convert_reversible KText KNumber _ (SObject _) _ prf | True = absurd $ prf
    convert_reversible KText KText _ SNull _ prf | True = absurd $ prf
    convert_reversible KText KText _ SBoolean _ prf | True = absurd $ prf
    convert_reversible KText KText _ SNumber _ prf | True = absurd $ prf
    convert_reversible KText KText _ SText SNull prf | True = absurd $ justInjective prf
    convert_reversible KText KText _ SText SBoolean prf | True = absurd $ justInjective prf
    convert_reversible KText KText _ SText SNumber prf | True = absurd $ justInjective prf
    convert_reversible KText KText m SText SText prf | True =
        rewrite sym $ justInjective prf in
        rewrite flip_map_preserves_validity KText KText m prf1 in Refl
    convert_reversible KText KText _ SText (SArray _ _) prf | True = absurd $ justInjective prf
    convert_reversible KText KText _ SText (SObject _) prf | True = absurd $ justInjective prf
    convert_reversible KText KText _ (SArray _ _) _ prf | True = absurd $ prf
    convert_reversible KText KText _ (SObject _) _ prf | True = absurd $ prf

||| Forwards and backwards compatibility requires schema transformations to be reversible
lens_reversible : (l : Lens) -> (s : Schema) -> (s' : Schema) ->
    transform_schema l s = Just s' -> transform_schema (reverse_lens l) s' = Just s
lens_reversible (Make k) s s' prf = make_reversible k s s' prf
lens_reversible (Destroy k) s s' prf = destroy_reversible k s s' prf
lens_reversible (AddProperty k) s s' prf = add_property_reversible k s s' prf
lens_reversible (RemoveProperty k) s s' prf = remove_property_reversible k s s' prf
lens_reversible (RenameProperty k k') s s' prf = rename_property_reversible k k' s s' prf
lens_reversible (HoistProperty h t) s s' prf = hoist_property_reversible h t s s' prf
lens_reversible (PlungeProperty h t) s s' prf = plunge_property_reversible h t s s' prf
lens_reversible Wrap s s' prf = wrap_reversible s s' prf
lens_reversible Head s s' prf = head_reversible s s' prf
lens_reversible (LensIn _ _) SNull _ Refl impossible
lens_reversible (LensIn _ _) SBoolean _ Refl impossible
lens_reversible (LensIn _ _) SNumber _ Refl impossible
lens_reversible (LensIn _ _) SText _ Refl impossible
lens_reversible (LensIn _ _) (SArray _ _) _ Refl impossible
lens_reversible (LensIn k l) (SObject m) s' prf with (get k m) proof prf1
    lens_reversible (LensIn k l) (SObject m) s' prf | Nothing = absurd $ prf
    lens_reversible (LensIn k l) (SObject m) s' prf | (Just s2) with (transform_schema l s2) proof prf2
        lens_reversible (LensIn k l) (SObject m) s' prf | (Just s2) | Nothing = absurd $ prf
        lens_reversible (LensIn k l) (SObject m) s' prf | (Just s2) | (Just s2') =
            rewrite sym $ justInjective prf in
            rewrite update_eq m k (Just s2') in
            rewrite lens_reversible l s2 s2' prf2 in
            rewrite update_shadow m k (Just s2') (Just s2) in
            rewrite update_same m k (Just s2) prf1 in Refl
lens_reversible (LensMap _) SNull _ Refl impossible
lens_reversible (LensMap _) SBoolean _ Refl impossible
lens_reversible (LensMap _) SNumber _ Refl impossible
lens_reversible (LensMap _) SText _ Refl impossible
lens_reversible (LensMap l) (SArray e s2) s' prf with (transform_schema l s2) proof prf1
    lens_reversible (LensMap l) (SArray e s2) s' prf | Nothing = absurd $ prf
    lens_reversible (LensMap l) (SArray e s2) s' prf | (Just s2') =
        rewrite sym $ justInjective prf in
        rewrite lens_reversible l s2 s2' prf1 in Refl
lens_reversible (LensMap _) (SObject _) _ Refl impossible
lens_reversible (Convert k k' m) s s' prf = convert_reversible k k' m s s' prf