moto

Введение

Создаем самый посещаемый ресурс по мототематике. Сначала в С-Пб, потом в Москве.

Задачи:

Определить интересы целевой аудитории. Клубы, тусовки, небходимые сервисы
Определить круг зарубежных ресурсов, с которых брать идеи
Выйти на рекламодателей, определить возможную окупаемость и схемы монетизации

Отличия от других:

Более демократичный ресурс чем мотобратан:
- модератор подписывается под баном
- можно баны обсуждать
- сообщество может отменить бан модератора!
Больше возможностей:
- поиск людей (ник, имя, район)
- разделы общения:
- по районам - для совместных прохватов (север, юг, пригороды)
- кварталы по классу мотоциклов (спорбайки, эндуро, etc)
  - новости, которые сегментирутся по кварталам.
  - пользователь может подписаться на разные кварталы и сформировать ленту, а также на разных людей (иерархические теги)
- прохваты - календарь
- карта с маршрутами прохватов
- статистика дтп как на motositizen
- отметить темы как прочитанные
- личные сообщения сделать удобнее чем на мотобратане и с поиском
Больше полезной информации о мотоциклах
- раздел с мануалами и поиском по мотоциклу
- раздел с поиском по запчастям
- раздел с “у кого спросить” по мотоциклу
- мотосервисы и отзывы о ремонтах
Никакой надоедливой рекламы (баннеров)
Разделы
- УСЛУГИ - в этом разделе пользователь должен увидеть, где какие гаражи можно арендовать, в каких мастерских можно починиться, где есть мотошколы, где зарегистрироваться или застраховаться и пр - то есть здесь надо собрать инфу обо всех услугах, которые могут пригодиться.
- ЗАПЧАСТИ - поиск запчастей как у частных так и по магазинам, отзывы с инфой где покупал эту запчасть https://www.louis.de/rubrik/motorradbekleidung-motorradhelme/1
- ПРОХВАТЫ
- БЛОГИ - сортировка новостей для удобства поиска (мало ли людям пригодится). Сортировать по источникам, например - СМИ (то есть газеты и проч известные сми), блоги, новости сайта.
- УГОНЫ. Совместные рейды против угонов с применением gps-locate
- ДТП
- ГАЛЕРЕЯ - как у харлея или тут http://www.dorna.com/dornacontents_wsbk.html
- Гонки
- Отчеты о путешествиях
- Брендованные страницы сервисов http://www.cobrausa.com/ https://www.louis.de/katalog/themen-welten/meine-werkstatt
- Статьи с кармой как на байкпосте
- Раздел для начинающих мотоциклистов
  - Где учиться (мотошколы)
  - Как выбрать мотоцикл, экип (магазины)
  - Лайфхаки
  - Безопасное вождение
  Разбивку по стажу можно легко сделать из данных по стажу и типу мото в гараже
- Мото-дети (кроссовая подготовка, тренера, ШКМГ)
- Мото-мастерские - узнать что ремонтируют и что заказывают
- Мотовыставки и мотофестивали
Трансляции с мотобратана, байкпоста и других сайтов, например ру_чп, в части мотоциклистов
Специальные тестовые программы устройств для пользователей сайтов
Места для безопасной парковки мота.
Мотофлирт с функционалом полноценного сайта знакомств.
Комментарии ко всему
Продажа мотоциклов с функицоналом авто.ру и синдикацией с авто.ру и авито
Юридическая помощь
Отслеживание камер и радаров (за карму) (по карте)
Карма
- отслеживать за что
- привлекать людей к оценке сколько дать за какое действие
Связь с админами
Система исправления орфографических (и не только) ошибок сначала для себя, а при подтверждении автором - и для других. С наглядностью диффа.
Заметки по юзерам: http://vk.com/ekaterina.klochkova На всякий пожарный. Ближайшую неделю меня не будет вконтактике. У меня есть телефон: +79218857023 и почта: kait.klochkova@gmail.com.
Поиск друзей с кем покататься Вводишь время, место и радиус, система находит друзей, и пишешь им - давай катать!
Мототур “по бабам”

Стартап

Одоната идея. жизнь на пракачку, или как из омеги заальфаться для задротов. приложение на мобилку, которое раздает тебе очки за то что ты делаешь что-то душеспасительное и полезное. связано с форсквэром, считывалкой штрихкодов и прочей поебней.

ты логгишься туда и тебе рисуют аватарку тупого дрыща, нихуя не умеющего в этой жизни. у тебя 0 уровень.

ты получаешь очки, когда отслеживалка находит тебя в фитнес-клубах, центрах обучения и т.д. если ты там появляешься регулярно - очки удваиваются, пока не поломаешь цепь регулярности. то есть 20 посещений качалки дают 20 очков, если ходить как поппало, или 40, если не ломать периодичность 2 раза в неделю. небольшое количество баллов получаешь, когда покупаешь полезную жратву или развивающие книги, гантели. спорт товары, оплачиваешь услуги обучения, медицинские услуги и проч. для этого используется сканер штрихкодоов

растет уровень - растет необходимое количество баллов для достижения следующего. более ценные баллы можно получить, предоставляя приложению докозательства успехов - сертификаты об окончании курсов на курсере, сдача нормативов по бегу или прочей хуйне, которую отмеряет шагометр, встроенный в мобилку, чекины с других концов планеты.

задроты - они задроты везде, и зарабатывая баллы будут прокачивать свою жизнь.

идея для коммерциализации - заключать контракты с магазинами спорт товаров/ресторанами здорового питания/ центрами обучения, что бы при оплате их услуг получать бонусные баллы

Одоната по пути побочные квестики - прочитай вот эту книжку, ответь на вопросики по содержанию, получи полюсик сходи в такой музейчик, отметься - держи еще один плюсик. на этой неделе пройдет вот такое мероприятие, сходи, получи супер бонус, а мы денег за рекламу от организаторов ага. ток что бы этим заняться мне надо либо с работы уволиться либо бросить спать. я чо эт хуйню то придумала. я узнада что мой клуб очки начисляет за посещения. и обнаружила, что как только об этом узнала. частота моих посещений возрасла до 3х раз в неделю. мне эти балы не дают нихуя. не даж так. НИХУЯШЕНЬКИ но воспитанное годами мышление задрота не позволяет упустить возможность заработать баллы

есть проблема, связанная с тем, что человеки - в общем-то ленивые скоты. а задроты еще и хитрые ленивые скоты и нужна система контроля.

поэтому эту хуйню надо строить изначально с привязкой к кому-нибудь. идеальный вариант - начать с физического состояния задрота, т.к. это самая болезненная тема раз, измеряется проще всего два. берем в одну руку сеть качалок - тот же задрипанный алекс фитнес и привязываем всю эту лабуду туда. менеджменту говорим, что ща продажи вырастут так, что охуеете а так же у вас будет мощная обратная связь с клиентурой. чувак не только чекинится в зале, но так же имеет возможность раз в месяц подойти к тренеру и сказать “смари как я умею”. тренер проверяет прогресс и говорит - молодца чувак. после чего на своей мобилке жамкает кнопулю, которая генерит qr-код. чувак считывает своей мобилой qr-код и переходит на след уровень. можно привязать персональные тренировки к этой лабуде. тренра жеж все равно дают роуд мап какй-то мол по понедельникам ты делаешь два притопа три прихлопа, во вторник дрочишь хуй, в четверг работаешь вот с такими мышцами вот такими упражнениями по столько подходов. для чувака который первый раз пришел в зал все это - китайская грамота и вылетает из ушей моментально (я вот в полном ахуе например была) - а тут тренер говорит, мол выполняешь программу с номером 15, вот те код - чувак его считывает мобилкой и имеет нормальное рассписание что и когда ему делать. и задно баллы получает.

делает это вместе с тренером - получает от тренера код, баллы удваиваются, в зале растут продажи персональных тренировок.

через нное количество времени получаем сеть посетителей сети клубов, которые радостно друг другу шлют фотаньки с бицухами и дают оценки тренерам (как бонус)

и тогда топаем в сеть школ, ну например иностранных языков. та же лабуда. получаешь баллы за то что приходишь на уроки, после экзамена и перехода на новый уровень владения языком получаешь от препода код. + мильен баллов и бэйджик. школам говорим - ща к вам прибежит клиентура в 100500 чуваков из качалок. потом туда же постепенно добавляем другие напрваления. автошколы, университеты, курсы повышения квалификации, оздоровительные программы и проч.

от всех организаций-участников получаем обратную связь по поводу того, как чувачки наши развиваются. каждый новый участник получает прирост клиентуры и охуенную рекламную площадку. участники игрули получают скидку на услугу компаний-участников. мы сидим и стрижем купоны. вин-вин

так как все участники реальны и действительно ходят во все эти хуйни, то мы будем единственной площадкой, которая может доказать, что отзывы, складирующиеся у нас (а люди ж те же голуби, им везде срать надо своим мнением) на 100% реальны, а не написаны пиарщиками или роботами

соответственно к нам начинают прибегать посторонние люди что бы получать объективную оченку мест в которые они хотят вписаться

Что улучшать

Типы для полей state нужно задавать как перечисления
Добавить AJAX и Comet
Автоматизированная генерация интерфейса для просмотра и редактирования сущностей
Забираем пользователей с других ресурсов
Очищалка базы для каждого модуля должна лежать в модуле
И сущности тоже туда переложить
Адаптивный дизайн

Сущности

Соберем все сущности и автоматы в один файл src/entityes.lisp

Функции для кодогенерации сущностей

Эти функции будут кодогенерировать сущности и автоматы из таблиц с наименованием и типами полей внутри этого файла.

Чтобы emacs не запрашивал подтверждение на каждое исполнение кода, установим эту настройку:

(setq org-confirm-babel-evaluate nil)

Функция outlist нужна для форматирования лисповых списков при генерации в s-выражения для entity:

(defun outlist (lst ident fn)
  (let ((outlist-result '())
        (first  (car lst))
        (middle (butlast (cdr lst)))
        (last   (car (last lst))))
    (cond ((equal 0 (length lst))
           (push (concat ident "()") outlist-result))
          ((equal 1 (length lst))
           (push (funcall fn (concat ident "(%s)") first) outlist-result))
          ((< 1 (length lst))
           (push (funcall fn (concat ident "(%s") first) outlist-result)
           (mapcar #'(lambda (x)
                       (push (funcall fn (concat "\n" ident " %s") x) outlist-result))
                   middle)
           (push (funcall fn (concat "\n" ident " %s)") last) outlist-result)))
   outlist-result))

Начнем с генерации кода из таблицы полей:

Это старая версия gen_fields:

(defun gen-fields (rows)
  (let ((result))
    (push "\n" result)
    (push (format "  (%s\n" (butlast (car rows))) result)
    (mapcar #'(lambda (x)
                (push (format "   %s\n" (butlast x)) result))
            (butlast (cdr rows)))
    (push (format "   %s)" (butlast (car (last rows)))) result)
    (mapconcat 'identity (reverse result) "")))

А теперь новая версия:

При генерации полей из таблиц описания сущностей некоторые поля имеют имя, но не имеют типа. Это нормально, т.к. они нужны для создания полей one-to-many при генерации поля для ORM. Такие поля мы выводим без указания типа.

(defun gen-fields (rows)
  (let ((fields) (primary) (foreign) (unique))
    (mapcar #'(lambda (val)
                (unless (string= "" (nth 3 val))
                  (mapcar #'(lambda (addon-key)
                              (let (meta-key)
                                (if (listp addon-key)
                                    (setq meta-key (car addon-key))
                                  (setq meta-key addon-key))
                                (cond
                                 ((string= meta-key 'primary)
                                  (push (car val) primary))
                                 ((string= meta-key 'one-to-many)
                                  (push (list 'one-to-many (car val) (nth 1 addon-key)) foreign))
                                 ((string= meta-key 'many-to-one)
                                  (push (list 'many-to-one (car val) (nth 1 addon-key)) foreign))
                                 ((string= meta-key 'unique)
                                  (push (car val) unique)))))
                          (read (nth 3 val)))))
            rows)
  (values
     (outlist rows "  "
              (function (lambda (tpl val)
                          (if (not (string= "" (nth 1 val)))
                               (if (string= "" (nth 2 val))
                                  (format tpl (subseq val 0 2))
                                  (format tpl (subseq val 0 3)))
                            (format tpl (list (car val)))))))
     primary
     (outlist (reverse foreign) "  "
              (function (lambda (tpl val)
                          (format tpl val))))
     unique)))

Теперь напишем код, который генерирует код для состояний конечного автомата:

Это его старая версия:

(defun gen-states (rows)
  (let ((result)
        (hash (make-hash-table :test #'equal))
        (states))
    (dolist (elt rows nil)
      (puthash (cadr elt) nil hash)
      (puthash (cadr (cdr elt))  nil hash))
    (maphash (lambda (k v)
               (push k states))
             hash)
    (push "\n" result)
    (push "  (" result)
    (dolist (elt (butlast states))
      (push (format ":%s " elt) result))
    (push (format ":%s)" (car (last states))) result)
    (mapconcat 'identity (reverse result) "")))

А это - новая:

(defun gen-states (rows)
  (let ((result)
        (hash (make-hash-table :test #'equal))
        (states))
    (dolist (elt rows nil)
      (puthash (cadr elt) nil hash)
      (puthash (cadr (cdr elt))  nil hash))
    (maphash (lambda (k v)
               (push k states))
             hash)
    (push "\n" result)
    (push "  (" result)
    (dolist (elt (butlast states))
      (push (format ":%s " elt) result))
    (push (format ":%s)" (car (last states))) result)
    (mapconcat 'identity (reverse result) "")))

И добавим к этом генератор действий - т.е. переходов между состояниями:

Это старая версия:

(defun gen-actions (rows)
  (let ((result))
    (push "\n" result)
    (let ((x (car rows)))
      (push (format "  ((:%s :%s :%s)" (cadr x) (cadr (cdr x)) (car x)) result))
    (if (equal 1 (length rows))
        (push ")" result)
      (progn
        (push "\n" result)
        (mapcar #'(lambda (x)
                    (push (format "   (:%s :%s :%s)\n" (cadr x) (cadr (cdr x)) (car x)) result))
                (cdr (butlast rows)))
        (let ((x (car (last rows))))
          (push (format "   (:%s :%s :%s))" (cadr x) (cadr (cdr x)) (car x)) result))))
    (mapconcat 'identity (reverse result) "")))

Это новая:

(defun gen-actions (rows)
  (let ((result))
    (push "\n" result)
    (let ((x (car rows)))
      (push (format "  ((:%s :%s :%s)" (cadr x) (cadr (cdr x)) (car x)) result))
    (if (equal 1 (length rows))
        (push ")" result)
      (progn
        (push "\n" result)
        (mapcar #'(lambda (x)
                    (push (format "   (:%s :%s :%s)\n" (cadr x) (cadr (cdr x)) (car x)) result))
                (cdr (butlast rows)))
        (let ((x (car (last rows))))
          (push (format "   (:%s :%s :%s))" (cadr x) (cadr (cdr x)) (car x)) result))))
    (mapconcat 'identity (reverse result) "")))

Плюс к этому нам нужны функции, которые меняют стиль написания идентификаторов:

(defun split-name (s)
  (split-string
   (let ((case-fold-search nil))
     (downcase
      (replace-regexp-in-string "\\([a-z]\\)\\([A-Z]\\)" "\\1 \\2" s)))
   "[^A-Za-z0-9]+"))

(defun camelcase  (s) (mapconcat 'capitalize (split-name s) ""))
(defun underscore (s) (mapconcat 'downcase   (split-name s) "_"))
(defun dasherize  (s) (mapconcat 'downcase   (split-name s) "-"))
(defun colonize   (s) (mapconcat 'capitalize (split-name s) "::"))

(defun camelscore (s)
  (cond ((string-match-p "\\(?:[a-z]+_\\)+[a-z]+" s)(dasherize  s))
        ((string-match-p "\\(?:[a-z]+-\\)+[a-z]+" s)(camelcase  s))
        ((string-match-p "\\(?:[A-Z][a-z]+\\)+$"  s)(colonize   s))
        (t(underscore s)) ))

(defun camelscore-word-at-point ()
  (interactive)
  (let* ((case-fold-search nil)
         (beg (and (skip-chars-backward "[:alnum:]:_-") (point)))
         (end (and (skip-chars-forward  "[:alnum:]:_-") (point)))
         (txt (buffer-substring beg end))
         (cml (camelscore txt)) )
    (if cml (progn (delete-region beg end) (insert cml)))))

Аналогичным образом напишем генератор, который собирает POST-запрос из таблицы с двумя столбцами, в первом из которых лежит ключ, а во втором - значение. Если значение начинается с символа двоеточия - то мы отправляем его “как есть” (но без двоеточия), а противном случае мы считаем его accessor-ом и кодируем в url-encode.

(defun gen-post (rows var)
  (flet ((rval (val var)
               (let ((match-result (string-match ":" val)))
                 (if (and (not (null match-result))
                          (= 0 (string-match ":" val)))
                     (concat "\"" (substring val 1) "\"")
                   (format ",(drakma:url-encode (%s %s) :utf-8)" val var)))))
    (let ((result))
      (push (format "`((\"%s\" . %s)"
                    (caar rows)
                    (rval (cadar rows) var)
                    var)
            result)
      (mapcar #'(lambda (x)
                  (push (format "\n  (\"%s\" . %s)"
                                (car x)
                                (rval (cadr x) var)
                                var)
                        result))
              (butlast (cdr rows)))
      (push (format "\n  (\"%s\" . %s))"
                    (caar (last rows))
                    (rval (cadar (last rows)) var)
                    var)
            result)
      (mapconcat 'identity (reverse result) ""))))

Соберем все это в один файл, чтобы загружать перед кодогенерацией проекта:

;; <<copyright>>

<<gen_org_confirm>>

<<outlist>>

<<change_case>>

<<gen_fields>>

<<gen_states>>

<<gen_actions>>

<<define-entity>>

<<with-entity>>

<<gen_post>>

И загрузим его:

(load-file "generators.el")

Теперь у нас есть все необходимое, чтобы написать вызываемые при tangle генераторы сущностей и автоматов.

При создании сущностей и автоматов мы формируем вызов define-entity или define-automat, предполагая, что параметры передаются в таком порядке:

Имя сущности/автомата
Описание
Список полей
Список primary-keys
Список внешних ключей
Список уникальных ключей

Затем, для автоматов передаются еще несколько параметров:

Список всех состояний автомата
Список действий при допустимых переходах

Это старый вариант генератора сущностей, который не учитывает реляционные связи:

А это новый вариант генератора сущностей:

Это старый вариант генератора автоматов, который не учитывает реляционные связи:

А это новый вариант генератора сущностей:

Функции для работы с lisp-сущностями

Главный макрос, разворачивающий промежуточное представление сущности в набор property list с удобным доступом к каждому полю

(defmacro define-entity (name desc slot-descriptions primary foreign unique &rest class-options)
  (let ((fields))
    ;; full initial hash with pair 'field-name' => 'slot-description'
    (mapcar #'(lambda(slot)
                (let ((base-data)
                      (name (car (subseq slot 0 1)))
                      (common-type)
                      (default)
                      (nullable)
                      (type)
                      (type-attrs)
                      (attrs))

                  (if (< 1 (length slot))
                      (setq common-type  (car (subseq slot 1 2))))

                  (if (< 2 (length slot))
                      (setq default (car (subseq slot 2 3))))

                  ;; преобразование типа из списка
                  (when (and (listp common-type) (string= "or" (car common-type)))
                    (setq type (car (last common-type)))
                    (setq type-attrs (cdr (last common-type)))
                    (setq nullable t))
                  (when (and (listp common-type) (not (string= "or" (car common-type))))
                    (setq type (car common-type))
                    (setq type-attrs (cdr common-type)))
                  (if (listp common-type)
                      (setq type (car common-type))
                    (setq type common-type))

                  (cond
                   ((string= "numeric" type)
                    (setq attrs (plist-put attrs :precision (nth 0 type-attrs)))
                    (setq attrs (plist-put attrs :scale (nth 1 type-attrs))))
                   ((string= "string" type)
                    (setq attrs (plist-put attrs :max (nth 0 type-attrs)))))

                  (setq fields
                        (plist-put fields (car slot)
                                   (list :name name
                                         :type type
                                         :attrs attrs
                                         :default default
                                         :nullable nullable)))))
            slot-descriptions)

    ;; let's parse type in more usable format

    ;;primary
    (mapcar #'(lambda (primary-field)
                (let ((field-value (plist-get fields primary-field)))
                  (when field-value
                    (plist-put fields primary-field (plist-put field-value :primary t)))))
            primary)

    ;;foreign
    (mapcar #'(lambda (foreign)
                (let ((foreign-field (nth 1 foreign))
                      (field-value (plist-get fields (nth 1 foreign))))
                  (when field-value
                    (plist-put fields foreign-field (plist-put field-value
                                                               (intern (concat ":" (symbol-name (nth 0 foreign))))
                                                               (nth 2 foreign)))))
                )
            foreign)

    ;;unique
    (mapcar #'(lambda (unique-field)
                (let ((field-value (plist-get fields unique-field)))
                  (when field-value
                    (plist-put fields unique-field (plist-put field-value :unique t)))))
            unique)

    ;; plist to normal list
    (setq fields (cl-loop for (key value) on fields by 'cddr
                          collect value
                          ))
    `',fields))

;; ;; пример
;; (define-entity message "Сущность сообщений"
;;   ((id serial)
;;    (type integer)
;;    (author integer)
;;    (target_user integer)
;;    (target_holder integer)
;;    (datetime datetime)
;;    (subject (string 127))
;;    (text text)
;;    (is_read boolean))
;;   (id)
;;   ((many-to-one type (message-type id))
;;    (many-to-one author (user id))
;;    (many-to-one target_user (user id))
;;    (many-to-one target_holder (holder id)))
;;   ())

(defmacro define-automat (name desc slot-descriptions primary foreign unique &rest class-options)
  (let
      ((fields))
    ;; full initial hash with pair 'field-name' => 'slot-description'
    (mapcar #'(lambda(slot)
                (let ((base-data)
                      (name (car (subseq slot 0 1)))
                      (common-type)
                      (default)
                      (nullable)
                      (type)
                      (type-attrs)
                      (attrs))

                  (if (< 1 (length slot))
                      (setq common-type (car (subseq slot 1 2))))
                  (if (< 2 (length slot))
                      (setq default (car (subseq slot 2 3))))

                  ;; преобразование типа из списка
                  (when (and (listp common-type) (string= "or" (car common-type)))
                    (setq type (car (last common-type)))
                    (setq type-attrs (cdr (last common-type)))
                    (setq nullable t))
                  (when (and (listp common-type) (not (string= "or" (car common-type))))
                    (setq type (car common-type))
                    (setq type-attrs (cdr common-type)))
                  (if (listp common-type)
                      (setq type (car common-type))
                    (setq type common-type))

                  (cond
                   ((string= "numeric" type)
                    (setq attrs (plist-put attrs :precision (nth 0 type-attrs)))
                    (setq attrs (plist-put attrs :scale (nth 1 type-attrs))))
                   ((string= "string" type)
                    (setq attrs (plist-put attrs :max (nth 0 type-attrs)))))

                  (setq fields
                        (plist-put fields (car slot)
                                   (list :name name
                                         :type type
                                         :attrs attrs
                                         :default default
                                         :nullable nullable)))))
            slot-descriptions)

    ;; let's parse type in more usable format

    ;;primary
    (mapcar #'(lambda (primary-field)
                (let ((field-value (plist-get fields primary-field)))
                  (when field-value
                    (plist-put fields primary-field (plist-put field-value :primary t)))))
            primary)

    ;;foreign
    (mapcar #'(lambda (foreign)
                (let ((foreign-field (nth 1 foreign))
                      (field-value (plist-get fields (nth 1 foreign))))
                  (when field-value
                    (plist-put fields foreign-field (plist-put field-value
                                                               (intern (concat ":" (symbol-name (nth 0 foreign))))
                                                               (nth 2 foreign)))))
                )
            foreign)

    ;;unique
    (mapcar #'(lambda (unique-field)
                (let ((field-value (plist-get fields unique-field)))
                  (when field-value
                    (plist-put fields unique-field (plist-put field-value :unique t)))))
            unique)

    ;; plist to normal list
    (setq fields (cl-loop for (key value) on fields by 'cddr
                          collect value
                          ))
    `',fields))

Теперь необходимо определить функцию, что будет вытягивать сгенерированное представление сущности из ее файла и отдавать запрошенные дополнительным параметром поля. Если список полей отсутствует или пустой, будет возвращен полный список полей сущности.

(defmacro with-entity (entity &optional fields)
  (let ((entity-data)
        (result-fields)
        (need-fields))
    ;; достаем сущность из сгенерированного файла
    (setq entity-data
          (eval (read
                 (with-temp-buffer
                   (insert-file-contents
                    (concat "./src/" (symbol-name entity) "-entity.lisp"))
                   (buffer-string)))))
    ;; фильтр по запрошенным полям
    (when fields
      (mapcar #'(lambda (field)
                  (if (listp field)
                      (setq need-fields (plist-put need-fields (car field) (cdr field)))
                    (setq need-fields (plist-put need-fields field nil))))
              fields))
    (if need-fields
        (setq result-fields
              (apply #'append
                     (mapcar #'(lambda (entity-field)
                                 (setq field-name (plist-get entity-field :name))
                                 (if (not (plist-member need-fields field-name))
                                     nil
                                   (setq result-field
                                         (if (plist-get need-fields field-name)
                                             (append entity-field
                                                     (plist-get need-fields field-name))
                                           entity-field))
                                   (setq result-field (plist-put result-field :entity entity))
                                   (list result-field)))
                             entity-data)))

      ;;[TODO:bgg] этот блок можно переписать лучше, избежав дублирования кода
      (setq result-fields
            (apply #'append
                   (mapcar #'(lambda (entity-field)
                               (setq result-field (plist-put entity-field :entity entity))
                               (list result-field))
                           entity-data))))
    `',result-fields))

;; ;; пример для message-entity без списка необходимых полей
;; (message "%s"
;;          (with-entity message))

;; ;; пример для message-entity со списком необходимых полей
;; (message "%s"
;;          (with-entity message
;;                       (id target_user target_holder)))

;; (print
;;  (pp
;;   (macroexpand-all
;;    '(with-entity message
;;                  (id
;;                   target_user
;;                   target_holder
;;                   (text :label "Your message"))))))

События

События протоколируют все что происходит в системе. Каждое создание сущности, каждое изменение состояния автомата регистрируется здесь. Роботы используют эти события для своей работы. Также информация о событиях попадает на главную страницу.

Событие является простой сущностью и не имеет состояния.

field name	field type	meta	note
id	serial	(primary)	идентификатор
name	(or db-null varchar)		имя события
tag	(or db-null varchar)		тег события
msg	(or db-null varchar)		сообщение или описание
author-id	(or db-null varchar)		инициатор события
ts-create	bigint		время события

Теперь сгенерируем код:

Роли (role)

Роли определяют набор сценариев, которые пользователь выполняет на сайте. Функционал, который выполняют сценарии запрашивает разрешение на выполнение действий, которое опирается на роль, присвоенную пользователю. Пользователь может иметь только одну роль или не иметь ее вовсе.

Роль является простой сущностью и не имеет состояния.

field name	field type	meta	note
id	serial	(primary)	идентификатор
name	varchar		имя
descr	(or db-null varchar)		описание

Теперь сгенерируем код и cоздадим необходимые роли:

Пользователи (user)

Для начала надо определиться, какие данные мы собираемся хранить о пользователях, и какого типа будут эти данные. Типы данных задаем в формате Postmodern чтобы потом сохранить данные в PostgreSQL

field name	field type	meta	note
id	serial	(primary)	идентификатор
name	varchar		никнейм пользователя
password	varchar		пароль
email	varchar		емейл
firstname	(or db-null varchar)		имя
lastname	(or db-null varchar)		фамилия
phone	(or db-null varchar)		телефон
mobilephone	(or db-null varchar)		мобильный телефон
sex	(or db-null varchar)		пол
birth-day	(or db-null varchar)		день рождения
birth-month	(or db-null varchar)		месяц рождения
birth-year	(or db-null varchar)		год рождения
ts-create	bigint		время регистрации
ts-last	bigint		время последнего действия
role-id	(or db-null integer)		идентификатор роли

В нашей системе пользователь может существовать (или не существовать) в одном из нескольких состояний:

Когда пользователь еще не зарегистрирован на сайте мы можем считать его незарегистрированным (unregistred)
После регистрации он автоматически становится залогиненным (logged)
Пользователь может покинуть сайт и перейти в состояние unlogged
Пользователь может забыть свой пароль, тогда мы должны выслать ему ссылку для восстановления пароля (sended)
И наконец, после восстановления пароля пользователь вновь становится залогиненным (logged)

Все эти переходы и состояния сведем в единую таблицу:

action	from	to
registration	unregistred	logged
unregistration	logged	unregistred
enter	unlogged	logged
leave	logged	unlogged
forgot	unlogged	sended
remember	sended	logged

Теперь мы можем полностью описать поведение пользователя как конечный автомат:

Для того чтобы избежать дублирования ников и связанной с этим ситуации, когда один пользователь выдает себя за другого, следует определить констрейнт на уникальность поля name и email

Так как в системе все пользователи тесно связаны с ролями, следует определить внешний ключ на таблицу ролей:

Теперь сгенерируем код и определим функции, которые вызываются на переходах из одного состояния в другое. Также установим ограничение на колонку name чтобы избежать дублирования ников.

Группы (group, user2group)

Группы пользователей определяют набор операций, которые пользователь может выполнять над объектами системы. В отличие от ролей, один пользователь может входить в несколько групп или не входить ни в одну из них.

Группа является простой сущностью и не имеет состояния.

field name	field type	meta	note
id	serial	(primary)	идентификатор
name	varchar		имя группы
descr	(or db-null varchar)		описание группы
ts-create	bigint		время создания группы
author-id	(or db-null integer)		идентификатор создателя группы

Сгенерируем код и создадим необходимые группы:

Теперь создадим таблицу связи, которая свяжет пользователей и группы:

field name	field type	meta	note
id	serial	(primary)	идентификатор
user-id	integer		идентификатор пользователя
group-id	integer		идентификатор группы

Чтобы пары в таблице связи удалялись при удалении связанных групп и пользователей следует установить on-delete foreigh keys.

И сгенерируем код для нее:

Сообщения (msg)

О сообщениях мы знаем только от кого они посылаются, кому и собственно текст сообщения. Его наверно не стоит ограничивать. По идее как посылающий, так и принимающий может удалить сообщение (пометить как удаленное), для этого мы используем отдельные флаги.

field name	field type	meta	note
id	serial	(primary)	идентификатор
snd-id	integer		пользователь, который послал сообщение
rcv-id	integer		пользователь, который получает сообщение
msg	varchar		сообщение
ts-create	bigint		время создания
ts-delivery	bigint		время доставки

Еще сообщение может быть доставлено или недоставлено.

action	from	to
delivery	undelivered	delivered

Теперь сгенерируем код и определим функции, которые вызываются на переходах

Задачи (task)

field name	field type	meta	note
id	serial	(primary)	идентификатор
name	varchar		название
blockdata	varchar		суть задачи или данные
owner-id	(or db-null integer)		идентификатор владельца
exec-id	(or db-null integer)		идентификатор исполнителя
ts-create	bigint		время регистрации

В нашей системе задача может существовать в одном из нескольких состояний:

Создана, но еще ни разу не исполнялась (new).
Исполняется в данный момент (inaction)
Была исполнена но еще не завершена, возможно потребуется исполнять еще раз или по расписанию (standby)
Отменена (cancelled)
Завершена (terminated)

Все эти переходы и состояния сведем в единую таблицу:

action	from	to
starttask	new	inaction
stoptask	inaction	standby
restarttask	standby	inaction
cancelnewtask	new	cancelled
cancelactiontask	inaction	cancelled
cancelstandbytask	standby	cancelled
terminateactiontask	inaction	terminated
terminatestandbytask	standby	terminated

Теперь мы можем полностью описать поведение пользователя как конечный автомат:

Для того чтобы избежать дублирования задач, следует определить констрейнт на уникальность поля name

Так как в системе все пользователи тесно связаны с задачами, следует определить внешний ключ на таблицу пользователей так, чтобы при удалении пользователей-владельцев задач удалялись и их задачи.

Теперь сгенерируем код и определим функции, которые вызываются на переходах из одного состояния в другое. Также установим ограничение на колонку name чтобы избежать дублирования ников.

Очереди (que, quelt)

Очереди используются для фолловинга и прочей подписки на обновления.

Нам нужна некоторая инфраструктура чтобы абстрагироваться от операций управления очередями, подписчиками и посылки сообщений. Потом ее можно будет изменить для поддержки RabbitMQ, Mbus или ZMQ или даже использовать все их одновременно для разных целей.

Очередь является простой сущностью и не имеет состояния.

field name	field type	default	meta	note
id	serial		(primary)	идентификатор
name	varchar			имя очереди

Нам понадобится сущность элемента очереди, назовем его quelt. Элемент очереди является простой сущностью и не имеет состояния.

field name	field type	meta	note
id	serial	(primary)	идентификатор
que-id	integer		идентификатор очереди
text	varchar		содержимое

Сгенерируем код и создадим необходимые очереди:

Аватары (avatar)

Пользователи имеют неопределенное кол-во аватарок, разного размера, для которых мы осуществляем хранение в оригинальном размере, масштабирование и хранение отмасштабированных превьюшек.

field name	field type	meta	note
id	serial	(primary)	идентификатор
user-id	integer		идентификатор пользователя
origin	varchar		путь к файлу оригинального размера
ts-create	bigint		время создания

Одна из автарок может быть активной в данный момент.

action	from	to
avatar-off	active	inactive
avatar-on	inactive	active

Теперь сгенерируем код и определим функции, которые вызываются на переходах

Когда какому-нибудь коду необходимо отобразить аватар он может получить путь к аватару, передав идентификатор пользователя и необходимый размер:

В будущем этот код будет генерироваться из исполняемой спецификации размеров и путей к аватаркам

События

Мы используем события, чтобы отслеживать и логгировать изменения в системе, которые происходят в ответ на действия внешних сил.

;;;; <<copyright>>
;;;; events.lisp

(in-package #:moto)

Модули