├── .gitignore ├── LICENSE ├── README.md └── src ├── extensible_records.idr ├── list.idr └── sample.idr /.gitignore: -------------------------------------------------------------------------------- 1 | *.ibc 2 | *.o 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Gonzalo 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # extensible-records 2 | [![License: MIT](https://img.shields.io/badge/License-MIT-blue.svg)](https://opensource.org/licenses/MIT) 3 | [![GitHub stars](https://img.shields.io/github/stars/gonzaw/extensible-records.svg)](https://github.com/gonzaw/extensible-records/stargazers) 4 | 5 | Extensible records for Idris, using Haskell's [HList](https://hackage.haskell.org/package/HList) as inspiration for its design and API. 6 | 7 | ## Getting Started 8 | 9 | To be able to run this project on your local machine you need to have `Idris` installed. Follow these instructions: https://github.com/idris-lang/Idris-dev/wiki/Installation-Instructions 10 | 11 | Afterwards, clone the repository and you can start working on the project. 12 | 13 | If you want to load the project into the Idris REPL do the following: 14 | 15 | ``` 16 | idris src/extensible_records.idr 17 | ``` 18 | 19 | If you want to load the samples into the RELP then do: 20 | 21 | ``` 22 | idris src/samples.idr 23 | ``` 24 | 25 | ## Usage 26 | 27 | To create records you can use the `.*.` operator, ending in a call to the empty record `emptyRec`, like so: 28 | 29 | ```idris 30 | r1 : Record [("surname", String), ("age", Int)] 31 | r1 = ("surname" .=. "Bond") .*. 32 | ("age" .=. 30) .*. 33 | emptyRec 34 | ``` 35 | 36 | To extend a record with new fields, call the `.*.` operator again: 37 | 38 | ```idris 39 | rExtended : Record [("name", String), ("surname", String), ("age", Int)] 40 | rExtended = ("name" .=. "James") .*. r1 41 | ``` 42 | 43 | ### Basic usage of other operators 44 | 45 | Beyond record extension, you can manipulate extensible records in many other ways using other operators. Here examples of some operators: 46 | 47 | ```idris 48 | r2 : Record [("surname", String), ("name", String)] 49 | r2 = ("surname" .=. "Bond") .*. 50 | ("name" .=. "James") .*. 51 | emptyRec 52 | 53 | r3 : Record [("name", String), ("code", String)] 54 | r3 = ("name" .=. "James") .*. 55 | ("code" .=. "007") .*. 56 | emptyRec 57 | 58 | -- Lookup 59 | r1 .!. "surname" 60 | 61 | -- Append 62 | rAppend : Record [("surname", String), ("age", Int), ("name", String), ("code", String)] 63 | rAppend = r1 .++. r3 64 | 65 | -- Update 66 | rUpdate : Record [("surname", String), ("age", Int)] 67 | rUpdate = updR "surname" r1 "Dean" 68 | 69 | -- Delete 70 | rDelete : Record [("age", Int)] 71 | rDelete = "surname" .//. r1 72 | ``` 73 | 74 | You can find more examples and ways to use such operators in the `samples.idr` file. 75 | 76 | ## Versioning 77 | 78 | We use [SemVer](http://semver.org/) for versioning. For the versions available, see the [tags on this repository](https://github.com/gonzaw/extensible-records/tags). 79 | 80 | ## License 81 | 82 | This project is licensed under the MIT License - see the [LICENSE](LICENSE) file for details 83 | 84 | ## Acknowledgments 85 | Big thank you to my professors Alberto Pardo and Marcos Viera from Universidad de la Republica for helping and guiding me in developing this library for my bacherlor thesis. 86 | Also thank you to the wonderful Idris community who provided helpful advice via IRC. 87 | -------------------------------------------------------------------------------- /src/extensible_records.idr: -------------------------------------------------------------------------------- 1 | module extensible_records 2 | 3 | import Data.List 4 | import list 5 | 6 | -- All functions must be total 7 | %default total 8 | 9 | -- All definitions and functions are exported 10 | %access public export 11 | 12 | 13 | -- *** Labelled Heterogeneous List *** 14 | 15 | infixr 4 .=. 16 | 17 | data Field : lty -> Type -> Type where 18 | (.=.) : (l : lty) -> (v : t) -> Field l t 19 | 20 | infix 5 :> 21 | 22 | data LHList : List (lty, Type) -> Type where 23 | HNil : LHList [] 24 | (:>) : Field lty t -> LHList ts -> LHList ((lty, t) :: ts) 25 | 26 | infixr 3 :++: 27 | 28 | -- Appends two labelled hlists 29 | (:++:) : LHList ts -> LHList us -> LHList (ts ++ us) 30 | (:++:) HNil ys = ys 31 | (:++:) (x :> xs) ys = x :> (xs :++: ys) 32 | 33 | 34 | -- *** Record *** 35 | 36 | data Record : List (lty, Type) -> Type where 37 | MkRecord : IsSet (labelsOf ts) -> LHList ts -> 38 | Record ts 39 | 40 | recToHList : Record ts -> LHList ts 41 | recToHList (MkRecord _ hs) = hs 42 | 43 | recLblIsSet : Record ts -> IsSet (labelsOf ts) 44 | recLblIsSet (MkRecord isS _) = isS 45 | 46 | emptyRec : Record [] 47 | emptyRec = MkRecord IsSetNil {ts=[]} HNil 48 | 49 | hListToRec : DecEq lty => {prf : IsSet (labelsOf ts)} -> LHList ts -> Record ts 50 | hListToRec {prf} hs = MkRecord prf hs 51 | 52 | 53 | -- *** Automatic generation of proofs *** 54 | 55 | TypeOrUnit : Dec p -> (p -> Type) -> Type 56 | TypeOrUnit (Yes yes) tyCons = tyCons yes 57 | TypeOrUnit (No _) _ = () 58 | 59 | mkTorU : (d : Dec p) -> (tyCons : p -> Type) -> 60 | (f : (prf : p) -> tyCons prf) -> 61 | TypeOrUnit d tyCons 62 | mkTorU (Yes yes) _ f = f yes 63 | mkTorU (No _) _ _ = () 64 | 65 | UnitOrType : Dec p -> (Not p -> Type) -> Type 66 | UnitOrType (Yes _) _ = () 67 | UnitOrType (No no) tyCons = tyCons no 68 | 69 | mkUorT : (d : Dec p) -> (tyCons : Not p -> Type) -> 70 | (f : (contra : Not p) -> tyCons contra) -> 71 | UnitOrType d tyCons 72 | mkUorT (Yes _) _ _ = () 73 | mkUorT (No no) _ f = f no 74 | 75 | -- TypeOrUnit with constant return type 76 | TypeOrUnitC : Dec p -> Type -> Type 77 | TypeOrUnitC d ty = TypeOrUnit d (\_ => ty) 78 | 79 | mkTorUC : (d : Dec p) -> (f : p -> ty) 80 | -> TypeOrUnitC d ty 81 | mkTorUC {ty} d f = mkTorU d (\_ => ty) 82 | (\p => f p) 83 | 84 | -- UnitOrType with constant return type 85 | UnitOrTypeC : Dec p -> Type -> Type 86 | UnitOrTypeC d ty = UnitOrType d (\_ => ty) 87 | 88 | mkUorTC : (d : Dec p) -> (f : Not p -> ty) 89 | -> UnitOrTypeC d ty 90 | mkUorTC {ty} d f = mkUorT d (\_ => ty) 91 | (\np => f np) 92 | 93 | 94 | -- *** Extension of record *** 95 | 96 | consR : DecEq lty => {l : lty} -> 97 | Field l t -> Record ts -> 98 | Not (Elem l (labelsOf ts)) -> 99 | Record ((l, t) :: ts) 100 | consR {ts} f (MkRecord isS fs) notLInTs = 101 | MkRecord (IsSetCons notLInTs isS) (f :> fs) 102 | 103 | MaybeE : DecEq lty => lty -> List (lty, Type) -> Type -> Type 104 | MaybeE l ts r = UnitOrTypeC (isElem l (labelsOf ts)) r 105 | 106 | infixr 6 .*. 107 | 108 | (.*.) : DecEq lty => {l : lty} -> 109 | Field l t -> Record ts -> 110 | MaybeE l ts (Record ((l, t) :: ts)) 111 | (.*.) {l} {ts} f r 112 | = mkUorTC (isElem l (labelsOf ts)) 113 | (\notp => consR f r notp) 114 | 115 | 116 | -- *** Lookup *** 117 | 118 | getType : (ts : List (lty, Type)) -> Elem l (labelsOf ts) -> 119 | Type 120 | getType ((l, ty) :: ts) Here = ty 121 | getType ((l, ty) :: ts)(There th) = getType ts th 122 | 123 | lookupH : (l : lty) -> LHList ts -> 124 | (isE : Elem l (labelsOf ts)) -> getType ts isE 125 | lookupH _ ((_ .=. v) :> _) Here = v 126 | lookupH l (_ :> hs) (There th) = lookupH l hs th 127 | 128 | lookupR : (l : lty) -> Record ts -> 129 | (isE : Elem l (labelsOf ts)) -> getType ts isE 130 | lookupR l (MkRecord _ fs) isE = lookupH l fs isE 131 | 132 | MaybeLkp : DecEq lty => List (lty, Type) -> lty -> Type 133 | MaybeLkp ts l = TypeOrUnit (isElem l (labelsOf ts)) 134 | (\isE => getType ts isE) 135 | 136 | infixr 7 .!. 137 | 138 | (.!.) : DecEq lty => Record ts -> (l : lty) -> 139 | MaybeLkp ts l 140 | (.!.) {ts} r l = mkTorU (isElem l (labelsOf ts)) 141 | (\isE => getType ts isE) 142 | (\isE => lookupR l r isE) 143 | 144 | 145 | -- *** Update *** 146 | 147 | updateH : DecEq lty => (l : lty) -> 148 | (isE : Elem l (labelsOf ts)) -> 149 | getType ts isE -> LHList ts -> LHList ts 150 | updateH l {ts=(l,_)::ts} Here v ( _ :> fs) = (l .=. v) :> fs 151 | updateH l {ts=(_,_)::ts} (There th) v (f :> fs) = f :> updateH l th v fs 152 | 153 | updateR : DecEq lty => (l : lty) -> 154 | (isE : Elem l (labelsOf ts)) -> 155 | getType ts isE -> Record ts -> Record ts 156 | updateR l isE v (MkRecord isS fs) = MkRecord isS (updateH l isE v fs) 157 | 158 | MaybeUpd : DecEq lty => List (lty, Type) -> lty -> Type 159 | MaybeUpd ts l = TypeOrUnit (isElem l (labelsOf ts)) 160 | (\isE => getType ts isE -> Record ts) 161 | 162 | updR : DecEq lty => (l : lty) -> Record ts -> MaybeUpd ts l 163 | updR {ts} l r = 164 | mkTorU (isElem l (labelsOf ts)) 165 | (\isE => getType ts isE -> Record ts) 166 | (\isE => \v => updateR l isE v r) 167 | 168 | 169 | -- *** Append *** 170 | 171 | appendR : DecEq lty => {ts, us : List (lty, Type)} -> 172 | Record ts -> Record us -> 173 | IsSet (labelsOf (ts ++ us)) -> Record (ts ++ us) 174 | appendR (MkRecord _ fs) (MkRecord _ gs) iS = MkRecord iS (fs :++: gs) 175 | 176 | MaybeApp : DecEq lty => List (lty, Type) -> 177 | List (lty, Type) -> Type -> Type 178 | MaybeApp ts us r = 179 | TypeOrUnitC (isSet (labelsOf (ts ++ us))) r 180 | 181 | infixr 7 .++. 182 | 183 | (.++.) : DecEq lty => {ts, us : List (lty, Type)} -> Record ts -> 184 | Record us -> MaybeApp ts us (Record (ts ++ us)) 185 | (.++.) {ts} {us} rt ru = 186 | mkTorUC (isSet (labelsOf (ts ++ us))) 187 | (\p => appendR rt ru p) 188 | 189 | 190 | -- *** Delete *** 191 | 192 | hDeleteH : DecEq lty => {ts : List (lty, Type)} -> (l : lty) -> LHList ts -> LHList (l ://: ts) 193 | hDeleteH {ts=[]} _ _ = HNil 194 | hDeleteH {ts=(l', ty)::ts} l (f :> fs) with (decEq l l') 195 | hDeleteH {ts=(l', ty)::ts} l (f :> fs) | Yes _ = fs 196 | hDeleteH {ts=(l', ty)::ts} l (f :> fs) | No _ = f :> hDeleteH l fs 197 | 198 | infixr 7 .//. 199 | 200 | (.//.) : DecEq lty => {ts : List (lty, Type)} -> (l : lty) -> Record ts -> 201 | Record (l ://: ts) 202 | (.//.) l (MkRecord isS fs) = 203 | let newFs = hDeleteH l fs 204 | newIsS = ifDeleteThenIsSet l isS 205 | in MkRecord newIsS newFs 206 | 207 | 208 | -- *** Delete Labels *** 209 | 210 | hDeleteLabelsH : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty ) -> LHList ts -> LHList (ls :///: ts) 211 | hDeleteLabelsH [] fs = fs 212 | hDeleteLabelsH (l :: ls) fs = hDeleteH l $ hDeleteLabelsH ls fs 213 | 214 | infixr 7 .///. 215 | 216 | (.///.) : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty) -> Record ts -> 217 | Record (ls :///: ts) 218 | (.///.) ls (MkRecord isS fs) = 219 | let newFs = hDeleteLabelsH ls fs 220 | newIsS = ifDeleteLabelsThenIsSet ls isS 221 | in MkRecord newIsS newFs 222 | 223 | 224 | -- *** Left Union *** 225 | 226 | hLeftUnionH : DecEq lty => {ts, us : List (lty, Type)} -> 227 | LHList ts -> LHList us -> 228 | LHList (ts :||: us) 229 | hLeftUnionH {ts} fs gs = fs :++: (hDeleteLabelsH (labelsOf ts) gs) 230 | 231 | infixr 7 .||. 232 | 233 | (.||.) : DecEq lty => {ts, us : List (lty, Type)} -> Record ts -> Record us -> 234 | Record (ts :||: us) 235 | (.||.) (MkRecord isS1 fs) (MkRecord isS2 gs) = 236 | let newFs = hLeftUnionH fs gs 237 | newIsS = ifLeftUnionThenisSet isS1 isS2 238 | in MkRecord newIsS newFs 239 | 240 | 241 | -- *** Left Projection *** 242 | 243 | projectLeftH : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty) -> 244 | LHList ts -> LHList (ls :<: ts) 245 | projectLeftH {ts=[]} _ HNil = HNil 246 | projectLeftH {ts=(l, _) :: _} ls fs with (isElem l ls) 247 | projectLeftH {ts=(l, _) :: _} ls (f :> fs) | Yes _ = f :> projectLeftH ls fs 248 | projectLeftH {ts=(l, _) :: _} ls (_ :> fs) | No _ = projectLeftH ls fs 249 | 250 | infixr 7 .<. 251 | 252 | (.<.) : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty) -> 253 | Record ts -> Record (ls :<: ts) 254 | (.<.) ls (MkRecord isS fs) = 255 | let newFs = projectLeftH ls fs 256 | newIsS = ifProjectLeftThenIsSet ls isS 257 | in MkRecord newIsS newFs 258 | 259 | 260 | -- *** Right Projection *** 261 | 262 | projectRightH : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty) -> 263 | LHList ts -> LHList (ls :>: ts) 264 | projectRightH {ts=[]} _ HNil = HNil 265 | projectRightH {ts=(l, _) :: _} ls fs with (isElem l ls) 266 | projectRightH {ts=(l, _) :: _} ls (_ :> fs) | Yes _ = projectRightH ls fs 267 | projectRightH {ts=(l, _) :: _} ls (f :> fs) | No _ = f :> projectRightH ls fs 268 | 269 | infixr 7 .>. 270 | 271 | (.>.) : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty) -> 272 | Record ts -> Record (ls :>: ts) 273 | (.>.) ls (MkRecord isS fs) = 274 | let newFs = projectRightH ls fs 275 | newIsS = ifProjectRightThenIsSet ls isS 276 | in MkRecord newIsS newFs 277 | -------------------------------------------------------------------------------- /src/list.idr: -------------------------------------------------------------------------------- 1 | module Record.List 2 | 3 | import Data.List 4 | 5 | -- All functions must be total 6 | %default total 7 | 8 | -- All definitions and functions are exported 9 | %access public export 10 | 11 | -- *** Properties of equality *** 12 | 13 | symNot : Not (x = y) -> Not (y = x) 14 | symNot notEqual Refl = notEqual Refl 15 | 16 | 17 | -- *** Properties of List *** 18 | 19 | consNotEqNil : {xs : List t} -> Not (x :: xs = []) 20 | consNotEqNil Refl impossible 21 | 22 | 23 | -- *** Properties of Elem *** 24 | 25 | noEmptyElem : Not (Elem x []) 26 | noEmptyElem Here impossible 27 | 28 | noElemInCons : Not (Elem x (y :: ys)) -> Not (Elem x ys) 29 | noElemInCons notElemCons elemTail = notElemCons $ There elemTail 30 | 31 | ifNotElemThenNotEqual : Not (Elem x (y :: ys)) -> Not (x = y) 32 | ifNotElemThenNotEqual notElemCons equal = notElemCons $ rewrite equal in Here 33 | 34 | ifNotEqualNotElemThenNotInCons : Not (Elem x ys) -> Not (x = y) -> Not (Elem x (y :: ys)) 35 | ifNotEqualNotElemThenNotInCons nIsE nEq Here = nEq Refl 36 | ifNotEqualNotElemThenNotInCons nIsE nEq (There th) = nIsE th 37 | 38 | 39 | -- *** Predicates over lists *** 40 | 41 | -- Represents that every element of the first list fulfills a predicate over the entire second list 42 | data AllOverList : (t -> List u -> Type) -> List t -> List u -> Type where 43 | AllOverListNil : AllOverList p [] us 44 | AllOverListCons : (v : t) -> p v us -> AllOverList p ts us -> AllOverList p (v :: ts) us 45 | 46 | -- All elements from the first list belong in the second list 47 | AllInList : List t -> List t -> Type 48 | AllInList ts us = AllOverList Elem ts us 49 | 50 | -- No element from the first list belong in the second list 51 | AllNotInList : List t -> List t -> Type 52 | AllNotInList ts us = AllOverList (\x => \xs => Not (Elem x xs)) ts us 53 | 54 | nothingIsInEmpty : (xs : List t) -> AllNotInList xs [] 55 | nothingIsInEmpty [] = AllOverListNil 56 | nothingIsInEmpty (x :: xs) = AllOverListCons x noEmptyElem (nothingIsInEmpty xs) 57 | 58 | ifAllNotInConsThenAllNotInRest : AllNotInList ls (x :: xs) -> AllNotInList ls xs 59 | ifAllNotInConsThenAllNotInRest AllOverListNil = AllOverListNil 60 | ifAllNotInConsThenAllNotInRest {ls = l :: _} (AllOverListCons l nIsE notAllInList) = 61 | let allNotInRest = ifAllNotInConsThenAllNotInRest notAllInList 62 | in AllOverListCons l (noElemInCons nIsE) allNotInRest 63 | 64 | ifAllNotInListAndValueNotInFirstOneThenNotInCons : Not (Elem y xs) -> AllNotInList xs ys -> AllNotInList xs (y :: ys) 65 | ifAllNotInListAndValueNotInFirstOneThenNotInCons nIsE AllOverListNil = AllOverListNil 66 | ifAllNotInListAndValueNotInFirstOneThenNotInCons nIsEY (AllOverListCons x nIsEX allNot) = 67 | let allNotInRest = ifAllNotInListAndValueNotInFirstOneThenNotInCons (noElemInCons nIsEY) allNot 68 | nEq = ifNotElemThenNotEqual nIsEY 69 | nIsEXCons = ifNotEqualNotElemThenNotInCons nIsEX (symNot nEq) 70 | in AllOverListCons x nIsEXCons allNotInRest 71 | 72 | ifAllNotInListThenOthersAreNotInFirstOne : AllNotInList xs ys -> AllNotInList ys xs 73 | ifAllNotInListThenOthersAreNotInFirstOne {ys} AllOverListNil = nothingIsInEmpty ys 74 | ifAllNotInListThenOthersAreNotInFirstOne (AllOverListCons _ nIsE allNot) = 75 | let allNotInXs = ifAllNotInListThenOthersAreNotInFirstOne allNot 76 | in ifAllNotInListAndValueNotInFirstOneThenNotInCons nIsE allNotInXs 77 | 78 | 79 | -- *** IsSet *** 80 | 81 | data IsSet : List t -> Type where 82 | IsSetNil : IsSet [] 83 | IsSetCons : Not (Elem x xs) -> IsSet xs -> IsSet (x :: xs) 84 | 85 | ifSetThenNotElemFirst : IsSet (x :: xs) -> Not (Elem x xs) 86 | ifSetThenNotElemFirst (IsSetCons notXIsInXs _) = notXIsInXs 87 | 88 | ifSetThenRestIsSet : IsSet (x :: xs) -> IsSet xs 89 | ifSetThenRestIsSet (IsSetCons _ xsIsSet) = xsIsSet 90 | 91 | ifNotSetHereThenNeitherThere : Not (IsSet xs) -> Not (IsSet (x :: xs)) 92 | ifNotSetHereThenNeitherThere notXsIsSet (IsSetCons xIsInXs xsIsSet) = notXsIsSet xsIsSet 93 | 94 | ifIsElemThenConsIsNotSet : Elem x xs -> Not (IsSet (x :: xs)) 95 | ifIsElemThenConsIsNotSet xIsInXs (IsSetCons notXIsInXs xsIsSet) = notXIsInXs xIsInXs 96 | 97 | -- Decidability function for IsSet 98 | isSet : DecEq t => (xs : List t) -> Dec (IsSet xs) 99 | isSet [] = Yes IsSetNil 100 | isSet (x :: xs) with (isSet xs) 101 | isSet (x :: xs) | No notXsIsSet = No $ ifNotSetHereThenNeitherThere notXsIsSet 102 | isSet (x :: xs) | Yes xsIsSet with (isElem x xs) 103 | isSet (x :: xs) | Yes xsIsSet | No notXInXs = Yes $ IsSetCons notXInXs xsIsSet 104 | isSet (x :: xs) | Yes xsIsSet | Yes xInXs = No $ ifIsElemThenConsIsNotSet xInXs 105 | 106 | 107 | -- *** Functions on List (lty, Type) *** 108 | 109 | labelsOf: List (lty, Type) -> List lty 110 | labelsOf = map fst 111 | 112 | infixr 3 ://: 113 | 114 | -- Deletes a single element from the list 115 | (://:) : DecEq lty => lty -> List (lty, Type) -> List (lty, Type) 116 | (://:) l [] = [] 117 | (://:) l ((l', ty) :: ts) with (decEq l l') 118 | (://:) l ((l', ty) :: ts) | Yes _ = ts 119 | (://:) l ((l', ty) :: ts) | No _ = (l', ty) :: (l ://: ts) 120 | 121 | infixr 4 :///: 122 | 123 | -- Deletes a list of elements from the list 124 | (:///:) : DecEq lty => List lty -> List (lty, Type) -> List (lty, Type) 125 | (:///:) [] ts = ts 126 | (:///:) (l :: ls) ts = l ://: (ls :///: ts) 127 | 128 | infixr 4 :||: 129 | 130 | -- Returns the left union of two lists 131 | (:||:) : DecEq lty => List (lty, Type) -> List (lty, Type) -> List (lty, Type) 132 | (:||:) ts us = ts ++ ((labelsOf ts) :///: us) 133 | 134 | infixr 4 :<: 135 | 136 | -- Returns left projection of a list 137 | (:<:) : DecEq lty => List lty -> List (lty, Type) -> List (lty, Type) 138 | (:<:) _ [] = [] 139 | (:<:) ls ((l, ty) :: ts) with (isElem l ls) 140 | (:<:) ls ((l, ty) :: ts) | Yes _ = (l, ty) :: (ls :<: ts) 141 | (:<:) ls ((l, _) :: ts) | No _ = ls :<: ts 142 | 143 | infixr 4 :>: 144 | 145 | -- Returns right projection of a lsit 146 | (:>:) : DecEq lty => List lty -> List (lty, Type) -> List (lty, Type) 147 | (:>:) _ [] = [] 148 | (:>:) ls ((l, ty) :: ts) with (isElem l ls) 149 | (:>:) ls ((l, _) :: ts) | Yes _ = ls :>: ts 150 | (:>:) ls ((l, ty) :: ts) | No _ = (l, ty) :: (ls :>: ts) 151 | 152 | 153 | -- *** Theorems on append *** 154 | 155 | ifIsInOneThenIsInAppend : DecEq lty => {ts, us : List (lty, Type)} -> {l : lty} -> 156 | Either (Elem l (labelsOf ts)) (Elem l (labelsOf us)) -> 157 | Elem l (labelsOf (ts ++ us)) 158 | ifIsInOneThenIsInAppend (Left isE) = ifIsElemThenIsInAppendLeft isE 159 | where 160 | ifIsElemThenIsInAppendLeft : DecEq lty => {ts, us : List (lty, Type)} -> {l : lty} -> 161 | Elem l (labelsOf ts) -> Elem l (labelsOf (ts ++ us)) 162 | ifIsElemThenIsInAppendLeft {ts=((_, _) :: _)} Here = Here 163 | ifIsElemThenIsInAppendLeft {ts=((_, _) :: _)} (There th) = 164 | let isEApp = ifIsElemThenIsInAppendLeft th 165 | in There isEApp 166 | ifIsInOneThenIsInAppend (Right isE) = ifIsElemThenIsInAppendRight isE 167 | where 168 | ifIsElemThenIsInAppendRight : DecEq lty => {ts, us : List (lty, Type)} -> {l : lty} -> 169 | Elem l (labelsOf us) -> Elem l (labelsOf (ts ++ us)) 170 | ifIsElemThenIsInAppendRight {ts=[]} isE' = isE' 171 | ifIsElemThenIsInAppendRight {ts=((_, _) :: _)} {us=[]} isE' = absurd $ noEmptyElem isE' 172 | ifIsElemThenIsInAppendRight {ts=((_, _) :: _)} {us=((_, _) :: _)} isE' = 173 | let isEApp = ifIsElemThenIsInAppendRight isE' 174 | in There isEApp 175 | 176 | ifIsInAppendThenIsInOne : DecEq lty => {ts, us : List (lty, Type)} -> {l : lty} -> 177 | Elem l (labelsOf (ts ++ us)) -> 178 | Either (Elem l (labelsOf ts)) (Elem l (labelsOf us)) 179 | ifIsInAppendThenIsInOne {ts=[]} isE = Right isE 180 | ifIsInAppendThenIsInOne {ts=((_, _) :: _)} Here = Left Here 181 | ifIsInAppendThenIsInOne {ts=((_, _) :: _)} (There th) = 182 | case (ifIsInAppendThenIsInOne th) of 183 | Left isE => Left $ There isE 184 | Right isE => Right isE 185 | 186 | ifNotInAppendThenNotInNeither : DecEq lty => {ts, us : List (lty, Type)} -> {l : lty} -> 187 | Not (Elem l (labelsOf (ts ++ us))) -> 188 | (Not (Elem l (labelsOf ts)), Not (Elem l (labelsOf us))) 189 | ifNotInAppendThenNotInNeither {ts=[]} {us} {l} notInAppend = (nIsE1, nIsE2) 190 | where 191 | nIsE1 : Not (Elem l []) 192 | nIsE1 isE = noEmptyElem isE 193 | 194 | nIsE2 : Not (Elem l (labelsOf us)) 195 | nIsE2 isE = notInAppend isE 196 | ifNotInAppendThenNotInNeither {ts=((lt, tyt) :: ts)} {us} {l} nIsEApp = (nIsE1, nIsE2) 197 | where 198 | nIsE1 : Not (Elem l (labelsOf ((lt, tyt) :: ts))) 199 | nIsE1 a with (decEq l lt) 200 | nIsE1 a | Yes ok 201 | = case a of 202 | Here => nIsEApp Here 203 | There th => nIsEApp (rewrite ok in Here) 204 | nIsE1 a | No contra 205 | = case a of 206 | Here => contra Refl 207 | There th => let isEApp = ifIsInOneThenIsInAppend (Left th) 208 | in nIsEApp (There isEApp) 209 | 210 | nIsE2 : Not (Elem l (labelsOf us)) 211 | nIsE2 isE = 212 | let isEApp = ifIsInOneThenIsInAppend (Right isE) 213 | in nIsEApp (There isEApp) 214 | 215 | ifNotInNeitherThenNotInAppend : DecEq lty => {ts, us : List (lty, Type)} -> {l : lty} -> 216 | (Not (Elem l (labelsOf ts)), Not (Elem l (labelsOf us))) -> 217 | Not (Elem l (labelsOf (ts ++ us))) 218 | ifNotInNeitherThenNotInAppend {ts=[]} (_, nIsE2) isEApp = nIsE2 isEApp 219 | ifNotInNeitherThenNotInAppend {ts=((_, _) :: _)} (nIsE1, _) Here = nIsE1 Here 220 | ifNotInNeitherThenNotInAppend {ts=((_, _) :: _)} (nIsE1, nIsE2) (There th) = 221 | let nIsEApp = ifNotInNeitherThenNotInAppend ((noElemInCons nIsE1), nIsE2) 222 | in nIsEApp th 223 | 224 | ifAppendIsSetThenEachIsSet : DecEq lty => {ts, us : List (lty, Type)} -> 225 | IsSet (labelsOf (ts ++ us)) -> 226 | (IsSet (labelsOf ts), IsSet (labelsOf us)) 227 | ifAppendIsSetThenEachIsSet {ts=[]} isS = (IsSetNil, isS) 228 | ifAppendIsSetThenEachIsSet {ts=((_, _) :: _)} (IsSetCons nIsE isS) = 229 | let (isSLeft, isSRight) = ifAppendIsSetThenEachIsSet isS 230 | nIsELeft = fst $ ifNotInAppendThenNotInNeither nIsE 231 | in (IsSetCons nIsELeft isSLeft, isSRight) 232 | 233 | ifEachIsSetThenAppendIsSet : DecEq lty => {ts, us : List (lty, Type)} -> 234 | (IsSet (labelsOf ts), IsSet (labelsOf us)) -> AllNotInList (labelsOf ts) (labelsOf us) -> 235 | IsSet (labelsOf (ts ++ us)) 236 | ifEachIsSetThenAppendIsSet {ts=[]} (_, isSU) AllOverListNil = isSU 237 | ifEachIsSetThenAppendIsSet {ts=(l, _) :: ts} {us} ((IsSetCons nIsET isST), isSU) (AllOverListCons l nIsEU overList) = 238 | let isSApp = ifEachIsSetThenAppendIsSet {ts} {us} (isST, isSU) overList 239 | nIsEApp = ifNotInNeitherThenNotInAppend (nIsET, nIsEU) 240 | in IsSetCons nIsEApp isSApp 241 | 242 | 243 | -- *** Theorems on delete *** 244 | 245 | ifDeleteThenIsNotElem : DecEq lty => {ts : List (lty, Type)} -> (l : lty) -> {l' : lty} -> 246 | Not (Elem l' (labelsOf ts)) -> Not (Elem l' (labelsOf (l ://: ts))) 247 | ifDeleteThenIsNotElem {ts=[]} l {l'} nIsE isEDel = absurd $ noEmptyElem isEDel 248 | ifDeleteThenIsNotElem {ts=(l'', ty)::ts} l {l'} nIsE isEDel with (decEq l l'') 249 | ifDeleteThenIsNotElem {ts=(l, ty)::ts} l {l'} nIsE isEDel | Yes Refl = (noElemInCons nIsE) isEDel 250 | ifDeleteThenIsNotElem {ts=(l', ty)::ts} l {l'} nIsE Here | No contra = nIsE Here 251 | ifDeleteThenIsNotElem {ts=(l'', ty)::ts} l {l'} nIsE (There th)| No _ = 252 | ifDeleteThenIsNotElem l {l'} {ts} (noElemInCons nIsE) th 253 | 254 | ifDeleteThenIsSet : DecEq lty => {ts : List (lty, Type)} -> (l : lty) -> IsSet (labelsOf ts) -> IsSet (labelsOf (l ://: ts)) 255 | ifDeleteThenIsSet {ts=[]} l isS = IsSetNil 256 | ifDeleteThenIsSet {ts=(l', ty)::ts} l (IsSetCons nIsE isS) with (decEq l l') 257 | ifDeleteThenIsSet {ts=(l, ty)::ts} l (IsSetCons nIsE isS) | Yes Refl = isS 258 | ifDeleteThenIsSet {ts=(l', ty)::ts} l (IsSetCons nIsE isS) | No _ = 259 | let nIsEDel = ifDeleteThenIsNotElem l {l'} nIsE 260 | isSDel = ifDeleteThenIsSet l isS 261 | in IsSetCons nIsEDel isSDel 262 | 263 | 264 | -- *** Theorems on delete labels *** 265 | 266 | ifDeleteLabelsThenIsNotElem : DecEq lty => {ts : List (lty, Type)} -> {l : lty} -> (ls : List lty) -> 267 | Not (Elem l (labelsOf ts)) -> Not (Elem l (labelsOf (ls :///: ts))) 268 | ifDeleteLabelsThenIsNotElem [] nIsE isEDel = absurd $ nIsE isEDel 269 | ifDeleteLabelsThenIsNotElem {ts} {l} (l' :: ls) nIsE isEDel = 270 | let nIsEDelLabels = ifDeleteLabelsThenIsNotElem ls {ts} nIsE 271 | in ifDeleteThenIsNotElem {l'=l} {ts=ls :///: ts} l' nIsEDelLabels isEDel 272 | 273 | ifDeleteLabelsThenIsSet : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty) -> IsSet (labelsOf ts) -> IsSet (labelsOf (ls :///: ts)) 274 | ifDeleteLabelsThenIsSet [] isS = isS 275 | ifDeleteLabelsThenIsSet (l :: ls) isS = 276 | let isSSub = ifDeleteLabelsThenIsSet ls isS 277 | in ifDeleteThenIsSet l isSSub 278 | 279 | ifDeleteThenResultsAreNotInList : DecEq lty => {ts : List (lty, Type)} -> {ls : List lty} -> (l : lty) -> 280 | AllNotInList ls (labelsOf ts) -> IsSet (labelsOf ts) -> 281 | AllNotInList (l :: ls) (labelsOf (l ://: ts)) 282 | ifDeleteThenResultsAreNotInList {ts=[]} l overList _ = AllOverListCons l noEmptyElem overList 283 | ifDeleteThenResultsAreNotInList {ts=(l', _) :: ts} l overList isS with (decEq l l') 284 | ifDeleteThenResultsAreNotInList {ts=(l, _) :: ts} l overList (IsSetCons nIsE _) | Yes Refl = 285 | let allNotInTs = ifAllNotInConsThenAllNotInRest overList 286 | in AllOverListCons l nIsE allNotInTs 287 | ifDeleteThenResultsAreNotInList {ts=(l', _) :: ts} l overList (IsSetCons _ isS) | No nEq = 288 | let overRest = ifAllNotInConsThenAllNotInRest overList 289 | delAreNotInRest = ifDeleteThenResultsAreNotInList {ts} l overRest isS 290 | (AllOverListCons _ nIsELSupInLs _) = ifAllNotInListThenOthersAreNotInFirstOne overList 291 | nIsELSupInCons = ifNotEqualNotElemThenNotInCons nIsELSupInLs (symNot nEq) 292 | in ifAllNotInListAndValueNotInFirstOneThenNotInCons nIsELSupInCons delAreNotInRest 293 | 294 | ifDeleteLabelsThenNoneAreInList : DecEq lty => (ls : List lty) -> (ts : List (lty, Type)) -> 295 | IsSet (labelsOf ts) -> 296 | AllNotInList ls (labelsOf (ls :///: ts)) 297 | ifDeleteLabelsThenNoneAreInList [] _ _ = AllOverListNil 298 | ifDeleteLabelsThenNoneAreInList (l :: ls) ts isS = 299 | let nInListTs = ifDeleteLabelsThenNoneAreInList ls ts isS 300 | isSDel = ifDeleteLabelsThenIsSet ls isS 301 | in ifDeleteThenResultsAreNotInList {ts = ls :///: ts} l nInListTs isSDel 302 | 303 | 304 | -- *** Theorems on left union *** 305 | 306 | ifLeftUnionThenIsNotElem : DecEq lty => {ts, us : List (lty, Type)} -> (l : lty) -> 307 | Not (Elem l (labelsOf ts)) -> Not (Elem l (labelsOf us)) -> 308 | Not (Elem l (labelsOf (ts :||: us))) 309 | ifLeftUnionThenIsNotElem {ts} {us} l nIsET nIsEU = 310 | let nIsEDelLabels = ifDeleteLabelsThenIsNotElem {ts=us} (labelsOf ts) nIsEU 311 | nIsEApp = ifNotInNeitherThenNotInAppend (nIsET, nIsEDelLabels) 312 | in nIsEApp 313 | 314 | ifLeftUnionThenisSet : DecEq lty => {ts, us : List (lty, Type)} -> 315 | IsSet (labelsOf ts) -> IsSet (labelsOf us) -> 316 | IsSet (labelsOf (ts :||: us)) 317 | ifLeftUnionThenisSet {ts} {us} isS1 isS2 = 318 | let isSDel = ifDeleteLabelsThenIsSet {ts=us} (labelsOf ts) isS2 319 | delLabelsNotInList = ifDeleteLabelsThenNoneAreInList (labelsOf ts) us isS2 320 | isSApp = ifEachIsSetThenAppendIsSet {ts} {us=(labelsOf ts) :///: us} (isS1, isSDel) delLabelsNotInList 321 | in isSApp 322 | 323 | 324 | -- *** Theorems on left projection *** 325 | 326 | ifProjectLeftThenIsNotElem : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty) -> 327 | Not (Elem l (labelsOf ts)) -> Not (Elem l (labelsOf (ls :<: ts))) 328 | ifProjectLeftThenIsNotElem {ts=[]} ls nIsE isEProj = noEmptyElem isEProj 329 | ifProjectLeftThenIsNotElem {ts=(l', _) :: ts} {l} ls nIsE isEProj with (isElem l' ls) 330 | ifProjectLeftThenIsNotElem {ts=(l, _) :: ts} {l} _ nIsE Here | Yes _ = nIsE Here 331 | ifProjectLeftThenIsNotElem {ts=(l', _) :: ts} {l} ls nIsE (There th) | Yes _ = 332 | ifProjectLeftThenIsNotElem {ts} ls (noElemInCons nIsE) th 333 | ifProjectLeftThenIsNotElem {ts=(l', _) :: ts} {l} ls nIsE isEProj | No _ = 334 | ifProjectLeftThenIsNotElem {ts} ls (noElemInCons nIsE) isEProj 335 | 336 | ifProjectLeftThenIsSet : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty) -> 337 | IsSet (labelsOf ts) -> IsSet (labelsOf (ls :<: ts)) 338 | ifProjectLeftThenIsSet {ts=[]} _ _ = IsSetNil 339 | ifProjectLeftThenIsSet {ts=(l, _) :: ts} ls isS with (isElem l ls) 340 | ifProjectLeftThenIsSet {ts=(l, _) :: ts} ls (IsSetCons nIsE isS) | Yes _ = 341 | let nIsEInProj = ifProjectLeftThenIsNotElem {ts} ls nIsE 342 | isSProj = ifProjectLeftThenIsSet {ts} ls isS 343 | in IsSetCons nIsEInProj isSProj 344 | ifProjectLeftThenIsSet {ts=(l, _) :: ts} ls (IsSetCons _ isS) | No _ = 345 | ifProjectLeftThenIsSet ls isS 346 | 347 | 348 | -- *** Theorems on right projection *** 349 | 350 | ifProjectRightThenIsNotElem : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty) -> 351 | Not (Elem l (labelsOf ts)) -> Not (Elem l (labelsOf (ls :>: ts))) 352 | ifProjectRightThenIsNotElem {ts=[]} ls nIsE isEProj = noEmptyElem isEProj 353 | ifProjectRightThenIsNotElem {ts=(l', _) :: ts} {l} ls nIsE isEProj with (isElem l' ls) 354 | ifProjectRightThenIsNotElem {ts=(l', _) :: ts} {l} ls nIsE isEProj | Yes _ = 355 | ifProjectRightThenIsNotElem {ts} ls (noElemInCons nIsE) isEProj 356 | ifProjectRightThenIsNotElem {ts=(l, _) :: ts} {l} _ nIsE Here | No _ = nIsE Here 357 | ifProjectRightThenIsNotElem {ts=(l', _) :: ts} {l} ls nIsE (There th) | No _ = 358 | ifProjectRightThenIsNotElem {ts} ls (noElemInCons nIsE) th 359 | 360 | ifProjectRightThenIsSet : DecEq lty => {ts : List (lty, Type)} -> (ls : List lty) -> 361 | IsSet (labelsOf ts) -> IsSet (labelsOf (ls :>: ts)) 362 | ifProjectRightThenIsSet {ts=[]} _ _ = IsSetNil 363 | ifProjectRightThenIsSet {ts=(l, _) :: ts} ls isS with (isElem l ls) 364 | ifProjectRightThenIsSet {ts=(l, _) :: ts} ls (IsSetCons _ isS) | Yes _ = 365 | ifProjectRightThenIsSet ls isS 366 | ifProjectRightThenIsSet {ts=(l, _) :: ts} ls (IsSetCons nIsE isS) | No _ = 367 | let nIsEInProj = ifProjectRightThenIsNotElem {ts} ls nIsE 368 | isSProj = ifProjectRightThenIsSet {ts} ls isS 369 | in IsSetCons nIsEInProj isSProj 370 | -------------------------------------------------------------------------------- /src/sample.idr: -------------------------------------------------------------------------------- 1 | module sample 2 | 3 | import extensible_records 4 | import Data.List 5 | 6 | -- All functions must be total 7 | %default total 8 | 9 | -- *** Initial records *** 10 | 11 | r1 : Record [("surname", String), ("age", Int)] 12 | r1 = ("surname" .=. "Bond") .*. 13 | ("age" .=. 30) .*. 14 | emptyRec 15 | 16 | r2 : Record [("surname", String), ("name", String)] 17 | r2 = ("surname" .=. "Bond") .*. 18 | ("name" .=. "James") .*. 19 | emptyRec 20 | 21 | r3 : Record [("name", String), ("code", String)] 22 | r3 = ("name" .=. "James") .*. 23 | ("code" .=. "007") .*. 24 | emptyRec 25 | 26 | -- *** Record Extension *** 27 | 28 | rExtended : Record [("name", String), ("surname", String), ("age", Int)] 29 | rExtended = ("name" .=. "James") .*. r1 30 | 31 | -- *** Lookup *** 32 | 33 | r1Surname : String 34 | r1Surname = r1 .!. "surname" 35 | -- "Bond" 36 | 37 | r1Age : Int 38 | r1Age = r1 .!. "age" 39 | -- 30 40 | 41 | 42 | -- *** Append *** 43 | 44 | rAppend : Record [("surname", String), ("age", Int), ("name", String), ("code", String)] 45 | rAppend = r1 .++. r3 46 | -- { "surname" = "Bond", "age" = 30, "name" = "James", "code" = "007" } 47 | 48 | 49 | -- *** Update *** 50 | 51 | rUpdate : Record [("surname", String), ("age", Int)] 52 | rUpdate = updR "surname" r1 "Dean" 53 | -- { "surname" = "Dean", "age" = 30 } 54 | 55 | 56 | -- *** Delete *** 57 | 58 | rDelete : Record [("age", Int)] 59 | rDelete = "surname" .//. r1 60 | -- { "age" = 30 } 61 | 62 | 63 | -- *** Delete Labels *** 64 | 65 | rDeleteLabels1 : Record [("age", Int), ("name", String)] 66 | rDeleteLabels1 = ["surname", "code"] .///. rAppend 67 | -- { "age" = 30, "name" = "James" } 68 | 69 | rDeleteLabels2 : Record [("age", Int), ("name", String)] 70 | rDeleteLabels2 = ["code", "surname"] .///. rAppend 71 | -- { "age" = 30, "name" = "James" } 72 | 73 | 74 | -- *** Left Union *** 75 | 76 | rLeftUnion1 : Record [("surname", String), ("age", Int), ("name", String), ("code", String)] 77 | rLeftUnion1 = r1 .||. r3 78 | -- { "surname" = "Bond", "age" = 30, "name" = "James", "code" = "007" } 79 | 80 | r4 : Record [("name", String), ("code", String)] 81 | r4 = ("name" .=. "Ronald") .*. 82 | ("code" .=. "007") .*. 83 | emptyRec 84 | 85 | rLeftUnion2 : Record [("surname", String), ("name", String), ("code", String)] 86 | rLeftUnion2 = r2 .||. r4 87 | -- { "surname" = "Bond", "name" = "James", "code" = "007" } 88 | 89 | rLeftUnion3 : Record [("name", String), ("code", String), ("surname", String)] 90 | rLeftUnion3 = r4 .||. r2 91 | -- { "name" = "Ronald", "code" = "007", "surname" = "Bond" } 92 | 93 | 94 | -- *** Projection *** 95 | 96 | r5 : Record [("name", String), ("surname", String), ("age", Int), ("code", String), ("supervisor", String)] 97 | r5 = ("name" .=. "James") .*. 98 | ("surname" .=. "Bond") .*. 99 | ("age" .=. 30) .*. 100 | ("code" .=. "007") .*. 101 | ("supervisor" .=. "M") .*. 102 | emptyRec 103 | 104 | rProjectLeft : Record [("name", String), ("age", Int), ("supervisor", String)] 105 | rProjectLeft = ["name", "supervisor", "age"] .<. r5 106 | -- { "name" = "James", "age" = 30, "supervisor" = "M" } 107 | 108 | rProjectRight : Record [("surname", String), ("code", String)] 109 | rProjectRight = ["name", "supervisor", "age"] .>. r5 110 | -- { "surname" = "Bond", "code" = "007" } 111 | --------------------------------------------------------------------------------