Start to move notepad management into a separate file

src/notepad/notepad.rkt

@@ -0,0 +1,203 @@
+#lang racket/base
+
+; Notepad application
+(provide
+  make-notepad
+  ; Notes operations
+  notepad-list-notes notepad-has-note?
+  notepad-raw-note notepad-formatted-note
+  notepad-update-note notepad-delete-note
+  ; Media operations
+  notepad-list-media notepad-has-media?
+  ; User operations
+
+  ; Format a note
+  notepad-format
+  ; Remove later
+  notepad-notes-dir
+  notepad-media-dir
+  )
+
+(require
+  racket/port
+  "notes.rkt"
+  "user.rkt"
+  "stored-objects.rkt"
+  (prefix-in scrib: scribble/reader)
+  )
+
+; Definition of a notepad
+; A notepad is described by a directory containing the following elements :
+; - a 'notepad.db' file, containing the notepad sqlite database
+; - a 'notes' directory, containing the contents of the notes
+; - a 'media' directory, containing files uploaded by the notepad authors
+
+; The sqlite database contains :
+; - a table of users
+; - a table of cookies, to manage edition of notepad
+; - a table of note metadata
+; - a table of media metadata
+
+; Notepad structure
+(struct notepad
+  (directory ; notepad directory
+   repository ; repository for stored objects
+   dev? ; development mode, to disable security features requiring https
+  ))
+
+; Create/open a notepad
+(define (make-notepad dir #:dev? [dev? #f])
+  (define repo-path (string-append dir "/notepad.db"))
+  (define repo (open-repository 'sqlite3 repo-path))
+  (user-init-repository repo)
+  (notepad
+    dir
+    repo
+    dev?))
+
+; Note directory
+(define (notepad-notes-dir np)
+  (string-append (notepad-directory np) "/notes"))
+
+; Media directory
+(define (notepad-media-dir np)
+  (string-append (notepad-directory np) "/media"))
+
+; List all notes
+; Return a list of all notes. Each note is a string.
+(define (notepad-list-notes np)
+  (map path->string (directory-list (notepad-notes-dir np))))
+
+; Note file path
+(define (notepad-note-path np note)
+  (string-append (notepad-notes-dir np) "/" note))
+
+; Does the notepad has a given note ?
+(define (notepad-has-note? np note)
+  (and note (file-exists? (notepad-note-path np note))))
+
+; Return a note under its raw format
+; Return #f if the note does not exists.
+(define (notepad-raw-note np note)
+  (and (notepad-has-note? np note)
+       (port->string (open-input-file (notepad-note-path np note)))))
+
+; Return a note in a formatted representation. Return a metadata table.
+; Return #f if the note does not exists.
+(define (notepad-formatted-note np note)
+  (and (notepad-has-note? np note)
+       (call-with-input-file (notepad-note-path np note)
+          notepad-format)))
+
+; Format a raw note input stream into an hash containing metadata and content
+(define (notepad-format in)
+  ; Metadata
+  (define metadata (make-hash))
+  ; Recursive parsing function
+  (define (collect parsed)
+    ; Recursively apply the parsing:
+    ; - filter out #f values (metadata tags)
+    ; - Two successive "\n" (i.e a blank line) are replaced by a '(br)
+    (define (recur lst)
+      (filter
+        values
+        (map
+          (lambda (x) (collect x))
+          (reverse
+            (foldl
+              (lambda (val res)
+                (if (and (not (null? res))
+                          (equal? "\n" val)
+                          (equal? "\n" (car res)))
+                    (cons '(br) res)
+                    (cons val res)))
+              '()
+              lst)))))
+    ; Parse and transform the content
+    (cond
+      ; Not a list => output as is
+      ((not (list? parsed)) parsed)
+      (#t
+        (case (car parsed)
+          ; @title{Title} : metadata: title of the page
+          ; @author{Author} : metadata: author of the page
+          ; @date{Date} : metadata: date of the page
+          ((title author date)
+            (hash-set! metadata (car parsed) (apply string-append (cdr parsed)))
+            #f)
+          ; @link[path]{Text} : content: link to another page
+          ((link)
+            `(a ((href ,(symbol->string (cadr parsed))))
+                ,@(recur (cddr parsed))))
+          ; @image[path]{Alt text} : content: image
+          ((image)
+            (define alt (apply string-append (cddr parsed)))
+            `(img ((src ,(symbol->string (cadr parsed)))
+                  (alt ,alt)
+                  (title ,alt))))
+          ; @strong{Text} : content : strong
+          ; @str{Text} : content : strong
+          ((strong str)
+            `(strong ,@(recur (cdr parsed))))
+          ; @emphase{Text} : content : emphase
+          ; @emp{Text} : content : emphase
+          ((emphase emp)
+            `(em ,@(recur (cdr parsed))))
+          ; @section{Text} : content : title and start of section
+          ((section)
+            `(h2 ,@(recur (cdr parsed))))
+          ; @subsection{Text} : content : title and start of subsection
+          ((subsection)
+            `(h3 ,@(recur (cdr parsed))))
+          ; @subsubsection{Text} : content : title and start of subsubsection
+          ((subsubsection)
+            `(h4 ,@(recur (cdr parsed))))
+          ; @paragraph[justify]{Text} : content : paragraph with an optional justification
+          ; @para[justify]{Text} : content : paragraph with an optional justification
+          ((paragraph para)
+            (if (not (null? (cdr parsed)))
+                (case (cadr parsed)
+                ((left) `(p ((style "text-align: left;")) ,@(recur (cddr parsed))))
+                ((right) `(p ((style "text-align: right;")) ,@(recur (cddr parsed))))
+                ((center centered) `(p ((style "text-align: center;")) ,@(recur (cddr parsed))))
+                (else `(p ,@(recur (cdr parsed)))))
+                #f))
+          ; Other kind of lists: recurse on them
+          (else
+            (recur parsed))
+          ))))
+  ; Parse
+  (hash-set!
+    metadata
+    'content
+    (collect
+      (scrib:read-inside in)))
+  metadata)
+
+; Update a note. If note and new-note are different, the note is renamed.
+(define (notepad-update-note np note new-note new-content)
+  (define old-file (and note (notepad-note-path np note)))
+  (define new-file (notepad-note-path np new-note))
+  ; Save page to file
+  (call-with-output-file
+    new-file
+    (lambda (out)
+      (display new-content out))
+    #:exists 'truncate/replace)
+  ; Name has changed ? If yes, remove the old page
+  (when (and old-file (file-exists? old-file) (not (equal? old-file new-file)))
+    (delete-file old-file)))
+
+; Delete a note
+(define (notepad-delete-note np note)
+  (define file (notepad-note-path np note))
+  (when (file-exists? file)
+    (delete-file file)))
+
+; List all media
+(define (notepad-list-media np)
+  (map path->string (directory-list (notepad-media-dir np))))
+
+; Does the notepad has a given media ?
+(define (notepad-has-media? np media)
+  (and media (file-exists? (string-append (notepad-media-dir np) "/" media))))

src/pages/notepad.rkt

@@ -5,7 +5,7 @@
   "templates.rkt"
   "../webcontainer/weblets.rkt"
   "../webcontainer/weblet-parameter.rkt"
-  (prefix-in scrib: scribble/reader)
+  "../notepad/notepad.rkt"
   "../notepad/user.rkt"
   "../notepad/stored-objects.rkt"
   web-server/http/redirect
@@ -34,17 +34,14 @@
 
 ; Notepad directory
 (define notepad-dir "notepad")
-; Database path
-(define notepad-repo-path (string-append notepad-dir "/notepad.db"))
-; Notes directory
-(define notes-dir (string-append notepad-dir "/notes"))
-; Media directory
-(define media-dir (string-append notepad-dir "/media"))
-; Create / open database
-(define notepad-repo (open-repository 'sqlite3 notepad-repo-path))
-(user-init-repository notepad-repo)
 ; Dev mode
 (define dev? #t)
+; Notepad
+(define notepad (make-notepad notepad-dir #:dev? dev?))
+; Notes directory
+(define notes-dir (notepad-notes-dir notepad))
+; Media directory
+(define media-dir (notepad-media-dir notepad))
 
 ; Secured : either protocol is https or dev mode is active
 (define (check-secured? param)
@@ -91,7 +88,7 @@
       (define connected-usr (get-user-from-weblet-parameter param))
       (define secured? (check-secured? param))
       (define can-edit? (and connected-usr secured?))
-      (define notes (map path->string (directory-list notes-dir)))
+      (define notes (notepad-list-notes notepad))
       `(article
         ,@(if (null? notes)
               '("Pas de notes.")
@@ -114,95 +111,15 @@
   (define secured? (check-secured? param))
   (define can-edit? (and connected-usr secured?))
   (define page (weblet-parameter-ref param 'page #f))
-  (define file (and page (string-append notes-dir "/" page)))
-  (define has-page? (file-exists? file))
+  (define page-metadata (notepad-formatted-note notepad page))
   (cond
-    (has-page?
-      ; Read the file and parse it into a list structure with scribble
-      (define parsed
-        (call-with-input-file file
-          (lambda (in) (scrib:read-inside in))))
-      ; Collect metadata and transform the structure into the content
-      (define (collect-result parsed hsh)
-        ; Recursively apply the parsing:
-        ; - filter out #f values (metadata tags)
-        ; - Two successive "\n" (i.e a blank line) are replaced by a '(br)
-        (define (recur lst)
-          (filter
-            values
-            (map
-              (lambda (x) (collect-result x hsh))
-              (reverse
-                (foldl
-                  (lambda (val res)
-                    (if (and (not (null? res))
-                              (equal? "\n" val)
-                              (equal? "\n" (car res)))
-                        (cons '(br) res)
-                        (cons val res)))
-                  '()
-                  lst)))))
-        ; Parse and transform the content
-        (cond
-          ; Not a list => output as is
-          ((not (list? parsed)) parsed)
-          (#t
-            (case (car parsed)
-              ; @title{Title} : metadata: title of the page
-              ; @author{Author} : metadata: author of the page
-              ; @date{Date} : metadata: date of the page
-              ((title author date)
-                (hash-set! hsh (car parsed) (apply string-append (cdr parsed)))
-                #f)
-              ; @link[path]{Text} : content: link to another page
-              ((link)
-                `(a ((href ,(symbol->string (cadr parsed))))
-                    ,@(recur (cddr parsed))))
-              ; @image[path]{Alt text} : content: image
-              ((image)
-                (define alt (apply string-append (cddr parsed)))
-                `(img ((src ,(symbol->string (cadr parsed)))
-                      (alt ,alt)
-                      (title ,alt))))
-              ; @strong{Text} : content : strong
-              ; @str{Text} : content : strong
-              ((strong str)
-                `(strong ,@(recur (cdr parsed))))
-              ; @emphase{Text} : content : emphase
-              ; @emp{Text} : content : emphase
-              ((emphase emp)
-                `(em ,@(recur (cdr parsed))))
-              ; @section{Text} : content : title and start of section
-              ((section)
-                `(h2 ,@(recur (cdr parsed))))
-              ; @subsection{Text} : content : title and start of subsection
-              ((subsection)
-                `(h3 ,@(recur (cdr parsed))))
-              ; @subsubsection{Text} : content : title and start of subsubsection
-              ((subsubsection)
-                `(h4 ,@(recur (cdr parsed))))
-              ; @paragraph[justify]{Text} : content : paragraph with an optional justification
-              ; @para[justify]{Text} : content : paragraph with an optional justification
-              ((paragraph para)
-                (if (not (null? (cdr parsed)))
-                    (case (cadr parsed)
-                    ((left) `(p ((style "text-align: left;")) ,@(recur (cddr parsed))))
-                    ((right) `(p ((style "text-align: right;")) ,@(recur (cddr parsed))))
-                    ((center centered) `(p ((style "text-align: center;")) ,@(recur (cddr parsed))))
-                    (else `(p ,@(recur (cdr parsed)))))
-                    #f))
-              ; Other kind of lists: recursed on them
-              (else
-                (recur parsed))
-              ))))
-      (define result (make-hash))
-      (define cnt (collect-result parsed result))
+    ( page-metadata
       ( (pages:template
-          #:title (hash-ref result 'title "Sans titre")
-          #:author (hash-ref result 'author "feuforeve.fr")
+          #:title (hash-ref page-metadata 'title "Sans titre")
+          #:author (hash-ref page-metadata 'author "feuforeve.fr")
           #:content
             `(article
-              ,@cnt
+              ,@(hash-ref page-metadata 'content "")
               ,@(if can-edit?
                 `((hr)
                   (a ((href ,(string-append "/notes/edit/" page))) "Éditer") " — "
@@ -227,12 +144,11 @@
   (define secured? (check-secured? param))
   (define method (weblet-parameter-method param))
   (define page (weblet-parameter-ref param 'page #f))
-  (define file (and page (string-append notes-dir "/" page)))
-  (define has-page? (and file (file-exists? file)))
+  (define page-raw-data (notepad-raw-note notepad page))
   (cond
     ( (and connected-usr secured? (eq? method 'get))
       ; User connected, get method : read the page
-      (define content (if has-page? (port->string (open-input-file file)) ""))
+      (define content (or page-raw-data ""))
       (define page-name (or page "nouvelle.note"))
       ( (pages:template
           #:title (string-append "Édition de la page '" page-name "'")
@@ -259,16 +175,8 @@
       (define new-page-content (weblet-parameter-ref param 'pagecontent #f))
       (define new-page-name (or (and (not (equal? "" page-name)) page-name)
                                 page))
-      (define new-file (string-append notes-dir "/" new-page-name))
-      ; Save page to file
-      (call-with-output-file
-        new-file
-        (lambda (out)
-          (display new-page-content out))
-        #:exists 'truncate/replace)
-      ; Name has changed ? If yes, remove the old page
-      (when (and (not (equal? file new-file)) has-page?)
-        (delete-file file))
+      ; Save page
+      (notepad-update-note notepad page new-page-name new-page-content)
       ; Redirect
       (redirect-to
         (string-append (if continue? "/notes/edit/" "/notes/show/") new-page-name)
@@ -289,8 +197,7 @@
   (define secured? (check-secured? param))
   (define method (weblet-parameter-method param))
   (define page (weblet-parameter-ref param 'page #f))
-  (define file (and page (string-append notes-dir "/" page)))
-  (define has-page? (file-exists? file))
+  (define has-page? (notepad-has-note? notepad page))
   (cond
     ( (and has-page? connected-usr secured? (eq? method 'get))
       ; Method get => ask for confirmation
@@ -311,7 +218,8 @@
         param))
     ( (and has-page? connected-usr secured? (eq? method 'post))
       ; Method post => remove
-      (delete-file file)
+      (notepad-delete-note notepad page)
+      ; Redirect
       (redirect-to
         "/notes/list"
         see-other))
@@ -333,7 +241,7 @@
       (define connected-usr (get-user-from-weblet-parameter param))
       (define secured? (check-secured? param))
       (define can-edit? (and connected-usr secured?))
-      (define files (map path->string (directory-list media-dir)))
+      (define files (notepad-list-media notepad))
       `(article
         ,@(if (null? files)
               '("Pas de fichiers.")