Coverage report: /home/ati/workspace/perec/persistence/set.lisp

Kind	Covered	All	%
expression	56	101	55.4
branch	0	0	nil

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;; -*- mode: Lisp; Syntax: Common-Lisp; -*-

2

;;;

3

4

;;;

5

;;; See LICENCE for details.

6

7

(in-package :cl-perec)

8

9

;;;;;;;

10

;;; Set

11

12

(defptype set (&optional sub-type)

13

(declare (ignore sub-type))

14

'(or list persistent-slot-set-container))

15

16

 ;; TODO: distinguish between set type and disjunct set type (the latter used in 1-n associations for example)

17

(defptype disjunct-set (&optional sub-type)

18

(declare (ignore sub-type))

19

'(or list persistent-slot-set-container))

20

21

;;;;;;;;;;;;;;;;;;;;;;;;;;;

22

;;; Lazy slot set container

23

24

(defclass* persistent-slot-set-container (set-container)

25

((object)

26

(slot)))

27

28

(defmethod insert-item ((set persistent-slot-set-container) (item persistent-object))

29

(bind ((slot (slot-of set)))

30

(update-records (name-of (table-of slot))

31

(columns-of slot)

32

(object-writer (object-of set))

33

(id-column-matcher-where-clause item))))

34

35

(defmethod delete-item ((set persistent-slot-set-container) (item persistent-object))

36

(bind ((slot (slot-of set)))

37

(update-records (name-of (table-of slot))

38

(columns-of slot)

39

'(nil nil)

40

(id-column-matcher-where-clause item))))

41

42

 (defmethod search-for-item ((set persistent-slot-set-container) (item persistent-object) &key &allow-other-keys)

43

(not-yet-implemented))

44

45

(defmethod size ((set persistent-slot-set-container))

46

(bind ((slot (slot-of set)))

47

(caar (execute (sql `(select (count *)

48

,(name-of (table-of slot))

49

                           ,(id-column-matcher-where-clause (object-of set) (id-column-of slot))))))))

50

51

(defmethod empty-p ((set persistent-slot-set-container))

52

(= 0 (size set)))

53

54

(defmethod empty! ((set persistent-slot-set-container))

55

(delete-slot-set (object-of set) (slot-of set)))

56

57

(defmethod list-of ((set persistent-slot-set-container))

58

(restore-slot-set (object-of set) (slot-of set)))

59

60

(defmethod (setf list-of) (new-value (set persistent-slot-set-container))

61

(store-slot-set (object-of set) (slot-of set) new-value))

62

63

(defmethod iterate-items ((set persistent-slot-set-container) fn)

64

(mapc fn (list-of set)))

65

66

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

67

;;; Lazy persistent set with identity

68

69

(defpclass persistent-set ()

70

())

71

72

 ;; TODO: implement persistent set with identity (needs a separate table just like m-n associations to store references)

73

74

(defmethod insert-item ((set persistent-set) (item persistent-object))

75

(not-yet-implemented))

76

77

(defmethod delete-item ((set persistent-set) (item persistent-object))

78

(not-yet-implemented))

79

80

(defmethod search-for-item ((set persistent-set) (item persistent-object) &key &allow-other-keys)

81

(not-yet-implemented))

82

83

(defmethod size ((set persistent-set))

84

(not-yet-implemented))

85

86

(defmethod empty-p ((set persistent-set))

87

(= 0 (size set)))

88

89

(defmethod empty! ((set persistent-set))

90

(not-yet-implemented))

91

92

(defmethod list-of ((set persistent-set))

93

(not-yet-implemented))

94

95

(defmethod (setf list-of) (new-value (set persistent-set))

96

(not-yet-implemented))

97

98

(defmethod iterate-items ((set persistent-set) fn)

99

(not-yet-implemented))