PasteRack.org
Paste # 64880
2014-09-01 15:37:55

Fork as a new paste.

Paste viewed 10 times.


Embed:

model.rkt

#lang racket/base

(require racket/list
         racket/local
         db)

(struct entries (db))
(struct entry (table id))

(define (initialize-chart! home)
  (define db (sqlite3-connect #:database home #:mode 'create))
  (define the-chart (entries db))
  (unless (table-exists? db "entries")
    (query-exec db
                (string-append
                 "CREATE TABLE entries "
                 "(id INTEGER PRIMARY KEY, title TEXT, ideal TEXT, real TEXT, "
                 "created_date TEXT, due_date TEXT, pid INTEGER)"))
    (entries-insert-entry!
     the-chart "Top-level Chart" "Ideal" "Real"
     (current-seconds) "NULL" "NULL")
    (entries-insert-entry!
     the-chart "Step 1" "Ideal" "Real"
     (current-seconds) "2014-08-30" (entry-id (first (entries-entries the-chart))))
    (entries-insert-entry!
     the-chart "Step 2" "Ideal" "Real"
     (current-seconds) "2014-08-30" (entry-id (first (entries-entries the-chart)))))
  the-chart)

; entry-insert-entry!: entries string*6 -> entry
; Adds entry to entries
(define (entries-insert-entry! a-entries t i r cd dd pid)
  (query-exec
   (entries-db a-entries)
   (string-append
    "INSERT INTO entries "
    "(title, ideal, real, created_date, due_date, pid) "
    "VALUES (?, ?, ?, ?, ?, ?)")
   t i r cd dd pid))

; entries-entries : entries -> (listof entry)
; returns (listof entry) in the table a-entries
(define (entries-entries a-entries)
  (local [(define (id->entry an-id)
            (entry a-entries an-id))]
    (map id->entry
         (query-list
          (entries-db a-entries)
          "SELECT id FROM entries"))))

; entries-top : entries -> entry
; returns top entry by selecting for MIN(id)
(define (entries-top a-entries)
  (local [(define (id->entry an-id)
            (entry a-entries an-id))]
    (id->entry
     (query-value
      (entries-db a-entries)
      "SELECT MIN(id) FROM entries"))))

; entry-title: entry -> string?
; Queries for entry title
(define (entry-title a-entry)
  (query-value
   (entries-db (entry-table a-entry))
   "SELECT title FROM entries WHERE id = ?"
   (entry-id a-entry)))

; entry-real: entry -> string?
; Queries for entry real text
(define (entry-real a-entry)
  (query-value
   (entries-db (entry-table a-entry))
   "SELECT real FROM entries WHERE id = ?"
   (entry-id a-entry)))

; entry-ideal: entry -> string?
; Queries for entry ideal text
(define (entry-ideal a-entry)
  (query-value
   (entries-db (entry-table a-entry))
   "SELECT ideal FROM entries WHERE id = ?"
   (entry-id a-entry)))

; entry-created: entry -> string?
; Queries for entry creation date
(define (entry-created a-entry)
  (query-value
   (entries-db (entry-table a-entry))
   "SELECT created_date FROM entries WHERE id = ?"
   (entry-id a-entry)))

; entry-due: entry -> string?
; Queries for entry due date
(define (entry-due a-entry)
  (query-value
   (entries-db (entry-table a-entry))
   "SELECT due_date FROM entries WHERE id = ?"
   (entry-id a-entry)))

; entry-parent: entry -> string?
; Queries for entry parent-id
(define (entry-parent a-entry)
  (query-value
   (entries-db (entry-table a-entry))
   "SELECT pid FROM entries WHERE id = ?"
   (entry-id a-entry)))

; entry-children : entry -> (listof step)
; returns child entries (respresented as step)
(define (entry-children a-entry)
  (local [(define (id->entry an-id)
            (entry a-entry an-id))]
    (map id->entry
         (query-list
          (entries-db (entry-table a-entry))
          "SELECT id FROM entries WHERE pid = ?"
          (entry-id a-entry)))))

(provide (all-defined-out))