0 | ||| The WithData module combines a record and an arbitrary payload. The intended use is to
  1 | ||| attach metadata to the payload.
  2 | module Libraries.Data.WithData
  3 |
  4 | import public Data.List.Quantifiers
  5 | import public Data.List
  6 | import public Data.Maybe
  7 | import public Libraries.Data.Record
  8 |
  9 | %hide Data.List.Quantifiers.Any.Any
 10 | %hide Data.List.Quantifiers.Any.any
 11 |
 12 | ||| A pair for a type and an attached record hosting metadata about that type
 13 | |||
 14 | ||| Intended usage
 15 | ||| --------------
 16 | ||| Only ever put plain types in the metadata
 17 | ||| Do not add functors such as `List` or `PTerm`. The functor instance
 18 | ||| for `WithData` is only functorial on its payload and not the metadata.
 19 | |||
 20 | ||| There is rarely any need to write down `WithData [ ... ] a` thanks to the
 21 | ||| `AddMetadata` type constructor.
 22 | |||
 23 | ||| While possible, you are not meant to pattern match on values of this type
 24 | ||| to extract the main payload, you can use the `val` projection, and to access
 25 | ||| metadata fields you can use `get` and `getAt` functions that will automatically
 26 | ||| compute and extract the value out of the metadata record.
 27 | |||
 28 | ||| Example usage
 29 | ||| -------------
 30 | ||| Given a value of type `value : WithData ["loc" :-: Location, "cached" :-: Bool] Term`
 31 | ||| we can access the `Term` by projecting our the underlying value:
 32 | ||| ```idris example
 33 | ||| termValue : Term
 34 | ||| termValue = value.val
 35 | ||| ```
 36 | ||| To access the metadata fields use `get` with the name of the field or `getAt` with
 37 | ||| the index of the field. For example "loc" is at index `0` therefore one can access
 38 | ||| it using `getAt 0`:
 39 | ||| ```idris example
 40 | ||| termLocation : Location
 41 | ||| termLocation = value `getAt` 0
 42 | ||| ```
 43 | ||| Similarly, we can obtain the "cached" field by giving its name directly
 44 | ||| ```idris example
 45 | ||| termCache : Bool
 46 | ||| termCache = value.get "cached"
 47 | ||| ```
 48 | public export
 49 | record WithData (additional : List KeyVal) (payload : Type) where
 50 |   constructor MkWithData
 51 |   metadata : Record additional
 52 |   val : payload
 53 |
 54 | ||| Add some metadata to a type given a label and a type for the metadata
 55 | ||| This function matches on the type and add it to the metadata record if it is alread a `WithData`
 56 | |||
 57 | ||| example:
 58 | ||| ```idris example
 59 | ||| Term : Type
 60 | |||
 61 | ||| RichTerm : Type
 62 | ||| RichTerm = AddMetadata ("loc" :-: Location) $ AddMetadata ("cached" :-: Bool) Term
 63 | ||| ```
 64 | ||| The example shows how to add the fields "loc" and "cached" to the type `Term` as metadata. Those
 65 | ||| fields can be accessed with `get` and `getAt` functions
 66 | public export
 67 | AddMetadata : KeyVal -> Type -> Type
 68 | AddMetadata lbl (WithData ls a) = WithData (lbl :: ls) a
 69 | AddMetadata lbl ty = WithData [lbl] ty
 70 |
 71 | ||| Obtain the value of the metadata at the given index
 72 | ||| @ ix The index of the value we are extracting
 73 | ||| @ inRange A proof the index is in range of the metadata record
 74 | export
 75 | getAt : (ix : Nat) ->
 76 |         (0 inRange : FindIndex ix fields === Just out) =>
 77 |         WithData fields a -> out
 78 | getAt ix rec = index rec.metadata ix
 79 |
 80 | ||| Obtain the value out of the payload record given its label, same as `(.get)`
 81 | ||| @ label The label of the value we are extracting
 82 | ||| @ inRange A proof that the label is in the record at the appropriate index with the appropriate type.
 83 | export
 84 | get :
 85 |     (0 label : String) ->
 86 |     -- ^ The field we are accessing
 87 |     {n : Nat} ->
 88 |     -- ^ The index of the field, this can usually be infered
 89 |     (0 inRange : NameInRange label fields === Just (n, out)) =>
 90 |     -- ^ A proof that the field is in the record, its position matches the index `n` and the type at that location is `out`
 91 |     WithData fields a ->
 92 |     -- ^ The data from which we are extracting the field
 93 |     out
 94 | get label rec = Record.get label rec.metadata
 95 |
 96 | ||| Obtain the value out of the payload record given its label, same as `get`.
 97 | ||| @ label The label of the value we are extracting.
 98 | ||| @ inRange A proof that the label is in the record at the appropriate index with the appropriate type.
 99 | export
100 | (.get) :
101 |     WithData fields a ->
102 |     -- ^ The data from which we are extracting the field
103 |     (0 field : String) ->
104 |     -- ^ The field we are accessing
105 |     {n : Nat} ->
106 |     -- ^ The index of the field, this can usually be infered
107 |     (0 inRange : NameInRange field fields === Just (n, out)) =>
108 |     -- ^ A proof that the field is in the record, its position matches the index `n` and the type at that location is `out`
109 |     out
110 | (.get) rec field = Record.get field rec.metadata
111 |
112 | ||| Update at the given index, updates cannot change the type of the field.
113 | ||| @ ix The index at which we update the value.
114 | ||| @ inRange A proof that the index is in range of the metadata record.
115 | ||| @ f The update function.
116 | export
117 | updateAt :
118 |     (ix : Nat) ->
119 |     -- ^ The index selected for updating
120 |     (inRange : FindIndex ix fields === Just out) =>
121 |     -- ^ The proof that the index is in range
122 |     (f : out -> out) ->
123 |     -- ^ The update function.
124 |     WithData fields a -> WithData fields a
125 | updateAt ix f = {metadata $= updateAt ix f}
126 |
127 | ||| Update the value with the given field name
128 | ||| @ label The label of the value we are updating
129 | ||| @ inRange A proof that the label is in the record at the appropriate index with the appropriate type.
130 | ||| @ f The update function.
131 | export
132 | update :
133 |     (0 label : String) ->
134 |     -- ^ The field we want to update
135 |     {n : Nat} ->
136 |     -- ^ The index of the field, this can usually be infered
137 |     (0 inRange : NameInRange label fields === Just (n, out)) =>
138 |     -- ^ A proof that the field is in the record, its position matches the index `n` and the type at that location is `out`
139 |     (f : out -> out) ->
140 |     -- ^ The update function for the field
141 |     WithData fields a ->
142 |     -- ^ The data for which we are updating the field
143 |     WithData fields a
144 | update label f = {metadata $= update label f}
145 |
146 | ||| Override the value at the given index.
147 | ||| @ n The index at which we replace our value.
148 | ||| @ inRange A proof that index is in range.
149 | ||| @ newVal The new value remplacing the existing one.
150 | export
151 | setAt :
152 |     (n : Nat) ->
153 |     -- ^ The index at which we override our value
154 |     (inRange : FindIndex n ls === Just out) =>
155 |     -- ^ A proof that the index is in range
156 |     (newVal : out) ->
157 |     -- ^ The new value that is going to replace the old one
158 |     WithData ls a ->
159 |     -- ^ The data for which we are overriding a value
160 |     WithData ls a
161 | setAt n v = {metadata $= setAt n v}
162 |
163 | ||| Override the value matching the given label
164 | ||| @ label The label of the value we are overriding.
165 | ||| @ inRange A proof that the label is in the record at the appropriate index with the appropriate type.
166 | ||| @ newVal The new value remplacing the existing one.
167 | export
168 | set :
169 |     (0 label : String) -> {n : Nat} ->
170 |     (0 inRange : NameInRange label ls === Just (n, out)) =>
171 |     (newVal : out) ->
172 |     WithData ls a -> WithData ls a
173 | set label val = {metadata $= Record.set label val}
174 |
175 |
176 | ||| Add a labelled value to the metadata
177 | export
178 | Add : (0 lbl : String) -> (_ : ty) -> a -> WithData [lbl :-: ty] a
179 | Add lbl ty x = MkWithData [ lbl :- ty ] x
180 |
181 | ||| Add value the payload, ignore the label since it's given by the type
182 | export
183 | (:+) : ty -> WithData ls a -> WithData (lbl :-: ty :: ls) a
184 | val :+ x = MkWithData (add lbl val x.metadata) x.val
185 |
186 | export infixr 8 :++
187 |
188 | ||| Drop the head element of the metadata
189 | export
190 | drop : WithData (l :: ls) a -> WithData ls a
191 | drop = {metadata $= Record.tail }
192 |
193 | ||| Drop the head element of the metadata
194 | export
195 | (.drop) : WithData (l :: ls) a -> WithData ls a
196 | (.drop) = {metadata $= Record.tail }
197 |
198 | ||| WithData is functiorial in its payload
199 | export
200 | Functor (WithData md) where
201 |   map f x = MkWithData x.metadata (f x.val)
202 |
203 | ------------------------------------------------------------------------------------------------
204 | -- Default fields for records
205 | ------------------------------------------------------------------------------------------------
206 |
207 | ||| An interface for default values, used to fill in missing values in metadata records
208 | public export
209 | interface HasDefault a | a where
210 |   defValue : a
211 |
212 | fromDefault : All (HasDefault . KeyVal.type) fs -> Record fs
213 | fromDefault [] = []
214 | fromDefault (_ :: y) = ? :- defValue :: fromDefault y
215 |
216 | ||| Construct a payload filled with default values for its metadata
217 | export
218 | MkDef : {fs : _} -> a -> (values : All (HasDefault . KeyVal.type) fs) => WithData fs a
219 | MkDef x = MkWithData ((fromDefault values)) x
220 |
221 | ||| Construct a value with metadata but ignore the labels
222 | export
223 | Mk : {fs : _} -> All KeyVal.type fs -> a -> WithData fs a
224 | Mk x y = MkWithData (fromElems x) y
225 |
226 | ||| Add a default value to an existing metadata record
227 | export
228 | AddDef :  (def : HasDefault ty) =>
229 |          WithData fl a -> WithData (lbl :-: ty :: fl) a
230 | AddDef x = (defValue @{def}) :+ x
231 |
232 | ------------------------------------------------------------------------------------------------
233 | -- WithData distributes with List and Maybe
234 | ------------------------------------------------------------------------------------------------
235 |
236 | export
237 | distribData : WithData fs (List a) -> List (WithData fs a)
238 | distribData x = map (MkWithData x.metadata) x.val
239 |
240 | export
241 | distribDataMaybe : WithData fs (Maybe a) -> Maybe (WithData fs a)
242 | distribDataMaybe (MkWithData metadata Nothing) = Nothing
243 | distribDataMaybe (MkWithData metadata (Just x)) = Just (MkWithData metadata x)
244 |
245 | export
246 | traverseDataMaybe : (a -> Maybe b) -> WithData fs a -> Maybe (WithData fs b)
247 | traverseDataMaybe f x = MkWithData x.metadata <$> f x.val
248 |
249 | ------------------------------------------------------------------------------------------------
250 | -- Interface implementations
251 | ------------------------------------------------------------------------------------------------
252 |
253 | export
254 | (eq : All (Eq . KeyVal.type) fs) => Eq (Record fs) where
255 |   (==) [] [] = True
256 |   (==) {eq = e :: es} {fs = (f :: fs)} (x :: xs) (y :: ys) = x.value == y.value && xs == ys
257 |
258 | export
259 | (eq : All (Eq . KeyVal.type) fs) => Eq a => Eq (WithData fs a) where
260 |   x == y = x.val == y.val && x.metadata == y.metadata
261 |
262 |