0 | module Data.Container.Base.Extension.Definition
  1 |
  2 | import Data.Container.Base.Object.Definition
  3 | import Data.Container.Base.Morphism.Definition
  4 |
  5 | import Misc
  6 |
  7 | ||| Extension of a container
  8 | ||| This allows us to talk about the content, or payload of a container
  9 | public export
 10 | record Ext (0 c : Cont) (x : Type) where
 11 |   constructor (<|)
 12 |   shapeExt : c.Shp
 13 |   index : c.Pos shapeExt -> x
 14 |
 15 | ||| In `Ext c x`, the container `c` is said to be "full off" values of type `x`
 16 | ||| `fullOf` is sometimes used as infix operator to aid readability
 17 | public export
 18 | fullOf : Cont -> Type -> Type
 19 | fullOf c x = Ext c x 
 20 |
 21 |
 22 | ||| To be thought of as a choice of a shape, and a sequence of choices one
 23 | ||| needs to make to reach a particular position. 
 24 | ||| For contianers that are not defined as fixpoints, this "choices" are not
 25 | ||| made using container machinery, but directly in Idris
 26 | ||| Nonetheless, even for `List`, to define a value of `Fin n` we have to 
 27 | ||| recursively go through a "path"
 28 | public export
 29 | Path : Cont -> Type
 30 | Path c = (x : c.Shp ** c.Pos x)
 31 |
 32 | ||| Every extension is a functor : Type -> Type
 33 | public export
 34 | Functor (Ext c) where
 35 |   map {c=shp !> pos} f (s <| v) = s <| f . v
 36 |
 37 | ||| Composition of extensions is a functor
 38 | public export
 39 | Functor (Ext d . Ext c) where
 40 |   map f e = (map f) <$> e
 41 |
 42 | ||| Ext is a functor of type Cont -> [Type, Type]
 43 | ||| On objects it maps a container to a polynomial functor
 44 | ||| On morphisms it maps a dependent lens to a natural transformation
 45 | ||| This is the action on morphisms
 46 | public export
 47 | extMap : c =%> d -> Ext c a -> Ext d a
 48 | extMap f (sh <| index) = let (y ** ky= (%!) f sh
 49 |                          in y <| (index . ky)
 50 |
 51 |
 52 | namespace ExtProofs
 53 |   ||| Mapping over an extension preserves its shape 
 54 |   public export
 55 |   mapShapeExt : {0 c : Cont} ->
 56 |     {0 f : a -> b} ->
 57 |     (l : c `fullOf` a) ->
 58 |     shapeExt (f <$> l) = shapeExt l
 59 |   mapShapeExt {c=shp !> pos} (sh <| _) = Refl
 60 |
 61 |   ||| Indexing over a mapped extension is the same as indexing over a rewrite
 62 |   ||| of the map
 63 |   public export
 64 |   mapIndexCont : {c : Cont} ->
 65 |     {0 f : a -> b} -> 
 66 |     (l : c `fullOf` a) ->
 67 |     (ps : c.Pos (shapeExt (f <$> l))) ->
 68 |     f (index l (rewrite sym (mapShapeExt {f=f} l) in ps))
 69 |       = index (f <$> l) ps
 70 |   mapIndexCont {c=shp !> pos} (sh <| contentAt) ps = Refl
 71 |
 72 | ||| Structure needed to store equality data for Ext.
 73 | ||| To prove that two extensions `e1, e2` are equal, we need to provide a proof
 74 | ||| in two steps, and use the first one to rewrite the second. That is, we need
 75 | ||| a) a proof that the chosen shape types are equal. This allows us to 
 76 | ||| rewrite the position maps of both extensions to the same type.
 77 | ||| b) for each shape, a proof that the positions are equal as types
 78 | public export
 79 | record EqExt (e1, e2 : Ext c a) where
 80 |   constructor MkEqExt
 81 |   ||| The shapes must be equal
 82 |   shapesEqual : e1.shapeExt = e2.shapeExt
 83 |   ||| For each position in that shape, the values must be equal
 84 |   ||| Relying on rewrite to get the correct type for the position
 85 |   valuesEqual : (: c.Pos (e1.shapeExt)) ->
 86 |     e1.index p =
 87 |     e2.index (rewrite__impl (c.Pos) (sym shapesEqual) p)
 88 |
 89 |
 90 | ||| Another alternative is to use DecEq, and a different explicit rewrite
 91 | public export
 92 | decEqExt : (e1, e2 : Ext c a) ->
 93 |   EqExt e1 e2 ->
 94 |   Dec (e1 = e2)
 95 |
 96 | {-
 97 | TODO how does automatic deriving of equality work if the number of positions is infinite? (As is the case with some containers)
 98 | Checking for equality by simple brute-force clearly cannot be done in finite time (this works for DecEq, but also for Eq since it is marked as total)
 99 |
100 | Can decidability work if the user provides a function to perform that check (perhaps by higher-order symbolic manipulation, as opposed to brute-force)?
101 |
102 | TODO the trick of using DecEq to create an Eq instance is used in DPair?
103 |
104 | -- decEqExt e1 e2 (MkEqExt shapesEqual valuesEqual)
105 | --   = Yes ?decEqExt_rhs_0 -- complicated, but doable?
106 | -}