anchor.diff:     (:effect 0)
      (:controversy 0)))
   
  -(defun stick-other-flag-on-target (flag ballot-box warstat)
  -  (multiple-value-bind (right up wrong down) (warflagger:ballot-box-totals ballot-box)
  -    (let ((pos (+ right up))
  -          (neg (+ wrong down)))
  -      (when (warflagger:score-vast-majority-p pos neg)
  -        (setf (gethash flag warstat) (nth-value 0 (warflagger:score-controversy pos neg)))))))
  -
  -(defun add-to-replies-count (warstats childcount)
  -  (unless (key-in-hash? :replies-immediate warstats)
  -    (setf (gethash :replies-immediate warstats) 0))
  -  (unless (key-in-hash? :replies-total warstats)
  -    (setf (gethash :replies-total warstats) 0))
  -  (incf (gethash :replies-immediate warstats))
  -  (incf (gethash :replies-total warstats) (1+ childcount)))
  -
  -(defun set-direction (warstat direction)
  -  (setf (gethash :direction warstat) (or direction :neutral)))
  -
  -;;FIXME: doesn't seem to function. Tree freshness should never be nil
  -(defun set-tree-freshness (warstat &rest timestamps)
  -  (setf
  -   (gethash :tree-freshness warstat)
  -   (car (or (sort (remove-if #'null timestamps) #'string< :key #'warflagger:js-compatible-utcstamp)
  -            (error "No timestamp found in tree")))))
  +(in-package :score-script-support)
  +;; Score-script-support is for tools that will be visible from within flags and directives
  +
  +(defun set-direction (direction)
  +  (unless (member direction '(:pro :con))
  +    (error "Not a valid direction"))
  +  (funcall *dispatch* :direction direction))
  +
  +(defun set-apply-to (type)
  +  (funcall *dispatch* :apply-to type))
  +
  +(defun set-other-flag (flag)
  +  (funcall *dispatch* :other-flag flag))
  +
  +(defun dont-flag ()
  +  (funcall *dispatch* :post-other-flag nil))
  +
  +(defun set-tree-freshness (dt)
  +  (funcall *dispatch* :tree-freshness dt))
  +
  +(defun disable ()
  +  (funcall *dispatch* :disable))
  +
  +(defun disable-parent ()
  +  (when-let ((parent (funcall *dispatch* :info :parent)))
  +    (and (functionp parent)
  +         (funcall parent :disable))))
  +
  +(defun reply-to-self-p ()
  +  (when-let ((parent (funcall *dispatch* :info :parent)))
  +    (and (functionp parent)
  +         (equal (funcall *dispatch* :info :author)
  +                (funcall parent :info :author)))))
  +
  +(defun parent-is-root-p ()
  +  (length1 (assoc-cdr :tree-address (get-opinion))))
  +
  +(defun blank-flag-p ()
  +  (eq :blank (funcall *dispatch* :info :other-flag)))
  +
  +(defun vote-down ()
  +  (funcall *dispatch* :cast-vote :down))
  +(defun vote-up ()
  +  (funcall *dispatch* :cast-vote :up))
  +(defun vote-right (&optional ref)
  +  (funcall *dispatch* :cast-vote :right :reference ref))
  +(defun vote-wrong (&optional ref)
  +  (funcall *dispatch* :cast-vote :wrong :reference ref))
   
   (defun add-alternative (iid)
  -  (hu:collecting-hash-table (:mode :append :existing *side-opinions*)
  -    (hu:collect (assoc-cdr :target (warflagger:opinion-by-id iid)) iid)))
  -
  -(defun add-side-opinion (iid)
  -  (hu:collecting-hash-table (:mode :append :existing *side-opinions*)
  -    (hu:collect (assoc-cdr :target (warflagger:opinion-by-id iid)) iid)))
  -
  -(defun apply-to (aspect iid)
  -  (unless (equal iid (lastcar *tree-address*))
  -    (error "IID problem: can't apply-to"))
  -  (if *apply-to*
  -      (warn "Apply-to is already set. No action taken.")
  -      (setf *apply-to* aspect)))
  -
  -(defun applied-to (applyto)
  -  (case applyto
  -    (:text (values *text-warstat* *text-ballot-box*))
  -    (:title (values *title-warstat* *title-ballot-box*))
  -    (otherwise (values *warstat* *ballot-box*))))
  -
  -(defun collect-warstats (key warstats &optional type)
  -  (let ((ws-store (case type
  -                    (:text *text-warstats*)
  -                    (:title *title-warstats*)
  -                    (otherwise *warstats*))))
  -    (setf (gethash key ws-store) warstats)))
  -
  -(defun execute-modifiers (modifiers tree-address other-flag direction author)
  -  (hu:collecting-hash-table (:mode :replace)
  -    (let ((*target-author* author)
  -          (*ballot-box* (warflagger:make-ballot-box))
  -          (*text-ballot-box* (warflagger:make-ballot-box))
  -          (*title-ballot-box* (warflagger:make-ballot-box))
  -          (*warstat* (initialize-warstats))
  -          (*text-warstat* (make-hash-table))
  -          (*title-warstat* (make-hash-table))
  -          (*apply-to* nil)
  -          (*other-flag* other-flag)
  -          (*direction* direction)
  -          (*tree-address* tree-address))
  -      (when (functionp modifiers)
  -        (funcall modifiers))
  -      (hu:collect :ballot-box *ballot-box*)
  -      (hu:collect :text-ballot-box *text-ballot-box*)
  -      (hu:collect :title-ballot-box *title-ballot-box*)
  -      (hu:collect :warstat *warstat*)
  -      (hu:collect :text-warstat *text-warstat*)
  -      (hu:collect :title-warstat *title-warstat*)
  -      (hu:collect :apply-to *apply-to*)
  -      (hu:collect :direction *direction*)
  -      (hu:collect :other-flag *other-flag*))))
  -
  -;;FIXME: flag-core is a little dense. Individual flags and directives should have a clearer
  -;; api. Consider rewriting with dispatch functions instead of dynamics.
  -(defun flag-core (other-flag direction iid author modifiers)
  -  (hu:with-keys (:ballot-box :text-ballot-box :title-ballot-box :warstat :text-warstat :title-warstat
  -                 :apply-to :direction :other-flag)
  -      (execute-modifiers modifiers (append *tree-address* (list iid)) other-flag direction author)
  -    ;;accumulate own warstats
  -    (set-direction warstat direction)
  -    ;; ws and bb belong to the target, not the current item.
  -    (multiple-value-bind (ws bb) (applied-to apply-to)
  -      (unless (warflagger:ballot-box-empty-p ballot-box)
  -        (warflagger:apply-ballot-box-to-warstats ballot-box warstat))
  -      (collect-warstats iid warstat)
  -      ;;FIXME: do we deal with text warstats for nonroot targets?
  -      (unless (warflagger:ballot-box-empty-p text-ballot-box)
  -        (warflagger:apply-ballot-box-to-warstats text-ballot-box text-warstat))
  -      (collect-warstats iid text-warstat :text)
  -      (unless (warflagger:ballot-box-empty-p title-ballot-box)
  -        (warflagger:apply-ballot-box-to-warstats title-ballot-box title-warstat))
  -      (collect-warstats iid title-warstat :title)
  -      ;;FIXME: Are there cases when an opinion and descendants should not be counted?
  -      (add-to-replies-count ws
  -                            (+ (gethash :replies-total warstat 0)
  -                               (gethash :replies-total text-warstat 0)
  -                               (gethash :replies-total title-warstat 0)))
  -      (unless (gethash :tree-freshness warstat)
  -        (set-tree-freshness warstat (assoc-cdr :datestamp (warflagger:opinion-by-id iid))))
  -      (set-tree-freshness ws
  -                          (gethash :tree-freshness ws)
  -                          (gethash :tree-freshness warstat) (gethash :tree-freshness text-warstat)
  -                          (gethash :tree-freshness title-warstat))
  -      (when other-flag
  -        (warflagger:cast-vote! ballot-box :up iid author)
  -        (stick-other-flag-on-target other-flag ballot-box ws))
  -      (cond
  -        ;;We don't cast own vote if it's not an other-flag. Return appropriate ballot box instead.
  -        ;;FIXME: how does our vote get in that ballot box?
  -        ((eq direction :pro)
  -         (warflagger:merge-ballot-boxes! bb ballot-box)
  -         bb)
  -        ((eq direction :con)
  -         (warflagger:merge-with-inverted-ballot-boxes! bb ballot-box)
  -         bb)
  -        (t nil)))))
  -
  -(in-package :score-script)
  -
  -;; Initial implementation of consensus scorer
  -
  -(defun negative-spam (&key iid author modifiers)
  -  (scss:flag-core :spam nil iid author modifiers))
  -(defun negative-inflammatory (&key iid author modifiers)
  -  (scss:flag-core :inflammatory nil iid author modifiers))
  -(defun negative-disagree (&key iid author modifiers)
  -  (when-let ((balbox (scss:flag-core nil :con iid author modifiers)))
  -    (warflagger:cast-vote! balbox :down iid author)))
  -(defun negative-dislike (&key iid author modifiers)
  -  (when-let ((balbox (scss:flag-core nil :con iid author modifiers)))
  -    (warflagger:cast-vote! balbox :down iid author)))
  -(defun negative-language-warning (&key iid author modifiers)
  -  (scss:flag-core :language-warning nil iid author modifiers))
  -(defun negative-disturbing (&key iid author modifiers)
  -  (scss:flag-core :disturbing nil iid author modifiers))
  -(defun negative-logical-fallacy (&key iid author modifiers)
  -  (scss:flag-core :logical-fallacy nil iid author modifiers))
  -(defun negative-needs-evidence (&key iid author modifiers)
  -  (when-let ((balbox (scss:flag-core nil :con iid author modifiers)))
  -    (warflagger:cast-vote! balbox :wrong iid author)))
  -(defun negative-raise-question (&key iid author modifiers)
  -  (when-let ((balbox (scss:flag-core nil :con iid author modifiers)))
  -    (warflagger:cast-vote! balbox :wrong iid author)))
  -(defun negative-out-of-bounds (&key iid author modifiers)
  -  (scss:flag-core :out-of-bounds nil iid author modifiers))
  -(defun positive-funny (&key iid author modifiers)
  -  (scss:flag-core :funny nil iid author modifiers))
  -(defun positive-agree (&key iid author modifiers)
  -  (when-let ((balbox (scss:flag-core nil :pro iid author modifiers)))
  -    (warflagger:cast-vote! balbox :up iid author)))
  -(defun positive-like (&key iid author modifiers)
  -  (when-let ((balbox (scss:flag-core nil :pro iid author modifiers)))
  -    (warflagger:cast-vote! balbox :up iid author)))
  -(defun positive-interesting (&key iid author modifiers)
  -  (scss:flag-core :interesting nil iid author modifiers))
  +  (funcall *dispatch* :add-alternative iid))
  +
  +(defun get-opinion ()
  +  (funcall *dispatch* :info :opinion))
  +
  +(defun get-opinion-created ()
  +  (assoc-cdr :datestamp (get-opinion)))
  +
  +(defun get-ballot-box ()
  +  (funcall *dispatch* :info :ballot-box))
  +
  +(defun enabledp ()
  +  (and (funcall *dispatch* :info :enabled)
  +       (not (eq :neutral (funcall *dispatch* :info :direction)))))
  +
  +;;FIXME: can't be run before post-flag, because of missing own vote
  +;;FIXME: likewise, can't be used for non other-flag for similar reasons.
  +;; could possibly just work with a copy of the ballot-box. might solve all of the problems
  +;;FIXME: At moment, this is the only subjective thing in score-script. Do we like that?
  +(defun approvedp ()
  +  "Essentially a vast-majority check on the current resource."
  +  (and (enabledp)
  +       (let ((balbox (get-ballot-box)))
  +         (if (warflagger:ballot-box-empty-p balbox)
  +             t
  +             (multiple-value-bind (right up wrong down) (warflagger:ballot-box-totals (get-ballot-box))
  +               (let ((pos (+ right up))
  +                     (neg (+ wrong down)))
  +                 (warflagger:score-vast-majority-p pos neg)))))))
  +
  +(defun run-modifiers ()
  +  (let ((mods (funcall *dispatch* :info :modifiers)))
  +    (when (functionp mods)
  +      (funcall mods))))
  +
  +(defmacro on-post (&body body)
  +  `(funcall *dispatch* :add-delayed-procedure
  +            (lambda ()
  +              ,@body)))
  +
  +(defun save-flag ()
  +  (funcall *dispatch* :save nil))
  +
  +(defun post-flag ()
  +  (funcall *dispatch* :post nil))
  +
  +(defun post-error (err)
  +  (disable)
  +  ;;FIXME: implement error storage
  +  (warn err))
  +
  +(eval-always
  +  (defmacro defflag (name &body body)
  +    (let ((opinion (gensym "opinion")))
  +      `(defun ,name (&key iid author modifiers)
  +         (let* ((,opinion (warflagger:opinion-by-id iid))
  +                (*dispatch* (scsc-dispatch iid *dispatch*
  +                                           (list :iid iid :author author :opinion ,opinion))))
  +           ,@body)))))
  +
  +
  +
  +(defflag scsc::negative-spam
  +  (set-other-flag :spam)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag))
  +
  +(defflag scsc::negative-inflammatory
  +  (set-other-flag :inflammatory)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag))
  +
  +(defflag scsc::negative-disagree
  +  (set-direction :con)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag)
  +  (when (enabledp)
  +    (vote-down)))
  +
  +(defflag scsc::negative-dislike
  +  (set-direction :con)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag)
  +  (when (enabledp)
  +    (vote-down)))
  +
  +(defflag scsc::negative-language-warning
  +  (set-other-flag :language-warning)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag))
  +
  +(defflag scsc::negative-disturbing
  +  (set-other-flag :disturbing)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag))
  +
  +(defflag scsc::negative-logical-fallacy
  +  (set-other-flag :logical-fallacy)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag))
  +
  +(defflag scsc::negative-needs-evidence
  +  (set-direction :con)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag)
  +  (when (enabledp)
  +    (vote-wrong)))
  +
  +(defflag scsc::negative-raise-question
  +  (set-other-flag :inflammatory)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag))
  +
  +(defflag scsc::negative-out-of-bounds
  +  (set-other-flag :out-of-bounds)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag))
  +
  +(defflag scsc::positive-funny
  +  (set-other-flag :funny)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag))
  +
  +(defflag scsc::positive-agree
  +  (set-direction :pro)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag)
  +  (when (enabledp)
  +    (vote-up)))
  +
  +(defflag scsc::positive-like
  +  (set-direction :pro)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag)
  +  (when (enabledp)
  +    (vote-up)))
  +
  +(defflag scsc::positive-interesting
  +  (set-other-flag :interesting)
  +  (set-tree-freshness (get-opinion-created))
  +  (run-modifiers)
  +  (save-flag)
  +  (post-flag))
  +
   ;;FIXME: this should go away
   (defun statements-evidence (&key iid author modifiers)
     (let ((vv (assoc-cdr :vote-value (warflagger:opinion-by-id iid))))
  
positive.code:    #:prep-scsc-for-execution
     #:*warstats*
     #:*text-warstats*
     #:*title-warstats*
     #:*tree-address*
     #:*text-ballot-box*
     #:*title-ballot-box*
     #:*warstat*
     #:*text-warstat*
     #:*title-warstat*
     #:*apply-to*
     #:*cascade*
     #:*other-flag*
     #:*direction*
     #:*target-author*
     #:stick-other-flag-on-target
     #:add-to-replies-count
     #:set-direction
     #:set-tree-freshness
     #:apply-to
     #:applied-to
     #:collect-warstats
     #:flag-core
     #:*ballot-box*
     #:*side-opinions*
     #:add-alternative
     #:add-side-opinion))
  
  (defpackage #:score-script
    (:use #:cl #:gadgets #:alexandria)
  
negative.code: 
  (in-package :score-script-support)
  
  (defvar *dispatch*)
  (defparameter *score-data* nil)
  
  (in-package :warflagger)
  
  