git.fiddlerwoaroof.com
model.lisp
4c3588fc
 ;; [[file:~/git_repos/lisp-sandbox/todo/README.org::*model.lisp%20source%20code][model.lisp source code:1]]
 ;; [[file:~/git_repos/lisp-sandbox/todo/README.org::package-include][package-include]]
6543149e
 (in-package :fwoar.todo)
 
4c3588fc
 ;; package-include ends here
 ;; [[file:~/git_repos/lisp-sandbox/todo/README.org::model-utils][model-utils]]
 (defparameter *cur-id* 0)
 (defun next-id ()
   (incf *cur-id*))
 
 (defparameter *completed-lens*
   (data-lens.lenses:make-hash-table-lens "completed"))
 
 (defun bool-to-yason (bool)
   (if bool
       'yason:true
       'yason:false))
 ;; model-utils ends here
 
6543149e
 (defvar *todos* (fset:empty-map))
 
4c3588fc
 ;; [[file:~/git_repos/lisp-sandbox/todo/README.org::todolist-manipulation][todolist-manipulation]]
6543149e
 (defun todos ()
   (gmap:gmap :seq
              (lambda (_ b)
                (declare (ignore _))
                b)
              (:map *todos*)))
 
4c3588fc
 (defun clear-todos ()
   (setf *todos*
         (fset:empty-map)))
 ;; todolist-manipulation ends here
 
 ;; [[file:~/git_repos/lisp-sandbox/todo/README.org::todo-accessor][todo-accessor]]
6543149e
 (defun todo (id)
   (let ((todo (fset:@ *todos* id)))
     todo))
 
 (defun (setf todo) (new-value id)
4c3588fc
   (setf (fset:@ *todos* id)
         new-value))
6543149e
 
 (defun delete-todo (id)
   (setf *todos*
         (fset:less *todos* id)))
4c3588fc
 ;; todo-accessor ends here
6543149e
 
4c3588fc
 ;; [[file:~/git_repos/lisp-sandbox/todo/README.org::new-todo][new-todo]]
4258e918
 (defvar *external-host*
   "localhost")
 (defvar *external-port*
   5000)
 
6543149e
 (defun new-todo (value)
   (let ((id (next-id)))
     (setf (todo id)
           (alexandria:alist-hash-table
            (rutilsx.threading:->>
             value
             (acons "completed" 'yason:false)
5fd28f99
             (acons "url"
                    (format nil "http://~a:~d/todo/~d"
                            *external-host*
                            *external-port*
                            id)))
6543149e
            :test 'equal))))
4c3588fc
 ;; new-todo ends here
6543149e
 
4c3588fc
 ;; [[file:~/git_repos/lisp-sandbox/todo/README.org::update-todo][update-todo]]
6543149e
 (defun update-todo (id v)
5fd28f99
   (let* ((old-todo (or (todo id)
                        (make-hash-table :test 'equal)))
          (in-hash-table (alexandria:alist-hash-table v :test 'equal))
          (update (data-lens.lenses:over *completed-lens*
                                         'bool-to-yason
                                         in-hash-table)))
     (setf (todo id)
           (serapeum:merge-tables old-todo
                                  update))))
4c3588fc
 ;; update-todo ends here
 
 (defmacro with-fresh-todos (() &body body)
   `(let ((*todos* (fset:empty-map)))
      ,@body))
 ;; model.lisp source code:1 ends here