Use define-persistent inheritance in pastebin

db4
Slava Pestov 2008-05-30 19:40:01 -05:00
parent cf0ed665bf
commit 73a06ed9b0
1 changed files with 39 additions and 37 deletions

View File

@ -15,18 +15,22 @@ IN: webapps.pastebin
! DOMAIN MODEL ! DOMAIN MODEL
! ! ! ! ! !
TUPLE: paste id summary author mode date contents annotations ; TUPLE: entity id summary author mode date contents ;
\ paste "PASTE" entity f
{ {
{ "id" "ID" INTEGER +db-assigned-id+ } { "id" "ID" INTEGER +db-assigned-id+ }
{ "summary" "SUMMARY" { VARCHAR 256 } +not-null+ } { "summary" "SUMMARY" { VARCHAR 256 } +not-null+ }
{ "author" "AUTHOR" { VARCHAR 256 } +not-null+ } { "author" "AUTHOR" { VARCHAR 256 } +not-null+ }
{ "mode" "MODE" { VARCHAR 256 } +not-null+ } { "mode" "MODE" { VARCHAR 256 } +not-null+ }
{ "date" "DATE" DATETIME +not-null+ , } { "date" "DATE" DATETIME +not-null+ }
{ "contents" "CONTENTS" TEXT +not-null+ } { "contents" "CONTENTS" TEXT +not-null+ }
} define-persistent } define-persistent
TUPLE: paste < entity annotations ;
\ paste "PASTES" { } define-persistent
: <paste> ( id -- paste ) : <paste> ( id -- paste )
\ paste new \ paste new
swap >>id ; swap >>id ;
@ -34,23 +38,17 @@ TUPLE: paste id summary author mode date contents annotations ;
: pastes ( -- pastes ) : pastes ( -- pastes )
f <paste> select-tuples ; f <paste> select-tuples ;
TUPLE: annotation aid id summary author mode contents date ; TUPLE: annotation < entity parent ;
annotation "ANNOTATION" annotation "ANNOTATIONS"
{ {
{ "aid" "AID" INTEGER +db-assigned-id+ } { "parent" "PARENT" INTEGER +not-null+ }
{ "id" "ID" INTEGER +not-null+ }
{ "summary" "SUMMARY" { VARCHAR 256 } +not-null+ }
{ "author" "AUTHOR" { VARCHAR 256 } +not-null+ }
{ "mode" "MODE" { VARCHAR 256 } +not-null+ }
{ "date" "DATE" DATETIME +not-null+ }
{ "contents" "CONTENTS" TEXT +not-null+ }
} define-persistent } define-persistent
: <annotation> ( id aid -- annotation ) : <annotation> ( parent id -- annotation )
annotation new annotation new
swap >>aid swap >>id
swap >>id ; swap >>parent ;
: fetch-annotations ( paste -- paste ) : fetch-annotations ( paste -- paste )
dup annotations>> [ dup annotations>> [
@ -76,8 +74,8 @@ M: paste entity-link
id>> "id" associate "$pastebin/paste" swap link>string ; id>> "id" associate "$pastebin/paste" swap link>string ;
M: annotation entity-link M: annotation entity-link
[ id>> "id" associate "$pastebin/paste" swap link>string ] [ parent>> "parent" associate "$pastebin/paste" swap link>string ]
[ aid>> number>string "#" prepend ] bi [ id>> number>string "#" prepend ] bi
append ; append ;
: pastebin-template ( name -- template ) : pastebin-template ( name -- template )
@ -147,7 +145,7 @@ M: annotation entity-link
[ validate-integer-id ] >>init [ validate-integer-id ] >>init
[ "id" value paste annotations>> paste-feed ] >>feed ; [ "id" value paste annotations>> paste-feed ] >>feed ;
: validate-paste ( -- ) : validate-entity ( -- )
{ {
{ "summary" [ v-one-line ] } { "summary" [ v-one-line ] }
{ "author" [ v-one-line ] } { "author" [ v-one-line ] }
@ -156,7 +154,7 @@ M: annotation entity-link
{ "captcha" [ v-captcha ] } { "captcha" [ v-captcha ] }
} validate-params ; } validate-params ;
: deposit-paste-slots ( tuple -- ) : deposit-entity-slots ( tuple -- )
now >>date now >>date
{ "summary" "author" "mode" "contents" } deposit-slots ; { "summary" "author" "mode" "contents" } deposit-slots ;
@ -170,10 +168,10 @@ M: annotation entity-link
"new-paste" pastebin-template >>template "new-paste" pastebin-template >>template
[ [
validate-paste validate-entity
f <paste> f <paste>
[ deposit-paste-slots ] [ deposit-entity-slots ]
[ insert-tuple ] [ insert-tuple ]
[ id>> "$pastebin/paste" <id-redirect> ] [ id>> "$pastebin/paste" <id-redirect> ]
tri tri
@ -195,31 +193,35 @@ M: annotation entity-link
: <new-annotation-action> ( -- action ) : <new-annotation-action> ( -- action )
<page-action> <page-action>
[ validate-paste ] >>validate [
{ { "id" [ v-integer ] } } validate-params
[ "id" param "$pastebin/paste" <id-redirect> ] >>display "id" value "$pastebin/paste" <id-redirect>
] >>display
[ [
f f <annotation> { { "id" [ v-integer ] } } validate-params
{ validate-entity
[ deposit-paste-slots ] ] >>validate
[ { "id" } deposit-slots ]
[ insert-tuple ] [
[ "id" value f <annotation>
! Add anchor here [ deposit-entity-slots ]
id>> "$pastebin/paste" <id-redirect> [ insert-tuple ]
] [
} cleave ! Add anchor here
parent>> "$pastebin/paste" <id-redirect>
]
tri
] >>submit ; ] >>submit ;
: <delete-annotation-action> ( -- action ) : <delete-annotation-action> ( -- action )
<action> <action>
[ { { "aid" [ v-number ] } } validate-params ] >>validate [ { { "id" [ v-number ] } } validate-params ] >>validate
[ [
f "aid" value <annotation> select-tuple f "id" value <annotation> select-tuple
[ delete-tuples ] [ delete-tuples ]
[ id>> "$pastebin/paste" <id-redirect> ] [ parent>> "$pastebin/paste" <id-redirect> ]
bi bi
] >>submit ; ] >>submit ;