(* A lens, to see better.

   license: GNU Lesser General Public License Version 2.1 or later           
   ------------------------------------------------------------------------- *)
From elpi.apps.derive.elpi Extra Dependency "lens.elpi" as lens.
From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook.
From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook.

From elpi Require Import elpi.
From elpi.apps Require Export derive.

(* Coq stdlib has no lens data type so we declare one here. To override with
  your own "copy", use Register as below *)
Local Set Primitive Projections.
Record Lens (a b c d : Type) : Type := mkLens
{ view : a -> c
; over : (c -> d) -> a -> b
}.
Register mkLens as elpi.derive.lens.make.

Arguments view {_ _ _ _} _ _.
Arguments over {_ _ _ _} _ _ _.

Definition set {a b c d} (l : Lens a b c d) new := over l (fun _ => new).
Register set as elpi.derive.lens.set.
Register view as elpi.derive.lens.view.

Definition compose {a b c d e f} (l1 : Lens a b c d) (l2 : Lens c d e f) : Lens a b e f :=
  mkLens a b e f (fun x => view l2 (view l1 x)) (fun u => over l1 (over l2 u)).
Register compose as elpi.derive.lens.compose.

(* Links the record, a field name (projection) and the lens focusing on that field *)
Elpi Db derive.lens.db lp:{{
  pred lens-db o:inductive, o:constant, o:constant.
}}.

(* standalone command *)
Elpi Command derive.lens.
Elpi Accumulate Db Header derive.lens.db.
Elpi Accumulate File derive_hook.
Elpi Accumulate File lens.
Elpi Accumulate Db derive.lens.db.
Elpi Accumulate lp:{{ 
  main [str I, str O] :- !, coq.locate I (indt GR), derive.lens.main GR O _.
  main [str I] :- !, coq.locate I (indt GR), derive.lens.main GR "_" _.
  main _ :- usage.
   
  usage :- coq.error "Usage: derive.lens <record name> [<output prefix>]".
}}.

   
(* hook into derive *)
Elpi Accumulate derive Db derive.lens.db.
Elpi Accumulate derive File lens.

#[synterp] Elpi Accumulate derive lp:{{
  derivation _ _ (derive "lens" (cl\ cl = []) true).
}}.

Elpi Accumulate derive lp:{{
  derivation (indt T) Prefix ff (derive "lens" (derive.lens.main T N) (lens-db T _ _)) :- N is Prefix ^ "_".
}}.
