(local { : Gdk } (require :lgi))
(local { : view } (require :fennel))
(local lume (require :lume))

(local modifier-keyvals
       ;; we need to detect and discard modifier-only key events when
       ;; looking for the next key in a key sequence. Gtk/Gdk
       ;; allegedly has KeyEvent.is_modifier to do this but it's always
       ;; 0 because GI doesn't expose it.
       (let [names
             [
              :Control_L
              :Control_R
              :Control
              :Shift_L
              :Shift_R
              :WakeUp                   ; labelled "Fn"
              :Super_L                  ; labelled with Windows logo
              :Super_R                  ; menu key? not on my keyboard
              :Alt_L
              :Alt_R
              :ISO_Level3_Shift         ; AltGr
              ]]
         (collect [_ n (ipairs names)]
           (values (Gdk.keyval_from_name n) n))))

(fn modifier? [keyval]
  (. modifier-keyvals keyval))

(fn keychord->spec [keychord]
  (let [Mod Gdk.ModifierType
        symbol (keychord:match "(%w+)$")
;        upper? (and (symbol:match "%u") true)
        modmask (accumulate [m 0 ;(if upper? Mod.SHIFT_MASK 0)
                             v (keychord:gmatch "(%w+)-")]
                  (match (v:lower)
                    "m" (bor m Mod.MOD1_MASK)
                    "c" (bor m Mod.CONTROL_MASK)
                    "s" (bor m Mod.MOD4_MASK)))]
    {
     :keyval (Gdk.keyval_from_name symbol)
     : modmask
     }))

(fn spec->index [spec]
  (string.format "%d:%d" spec.keyval spec.modmask))

(fn event->index [event]
  (let [modmask
        (accumulate [m 0
                     k _ (pairs event.state)]
          (bor m (. Gdk.ModifierType k)))]
    (spec->index {:keyval event.keyval : modmask})))

(fn compact [xs]
  (icollect [_ v (ipairs xs)] v))

(fn index->string [index]
  (let [Mod Gdk.ModifierType
        [keyval modmask] (lume.map (lume.split index ":") tonumber)
        chars []]
    (if (> (band modmask Mod.CONTROL_MASK) 0) (table.insert chars "C"))
    (if (> (band modmask Mod.MOD1_MASK) 0) (table.insert chars "M"))
    (if (> (band modmask Mod.MOD4_MASK) 0) (table.insert chars "S"))
    (table.insert chars (Gdk.keyval_name keyval))
    (table.concat chars  "-")))

(let [v (index->string "103:0")] (assert (= v "g") v))
(let [v (index->string "65:0")] (assert (= v "A") v))
(let [v (index->string "120:4")] (assert (= v "C-x") v))
(let [v (index->string "100:8")] (assert (= v "M-d") v))
(let [v (index->string "100:12")] (assert (= v "C-M-d") v))

(fn command? [tbl]
  ;; a keymap entry has a string as key, a command
  ;; definition is a numerically-indexed array
  (if (. tbl 1) true))

(fn keymap? [tbl]
  (not (. tbl 1)))

(fn compile-keymap [input]
  (collect [k v (pairs input)]
    (let [f (-> k keychord->spec spec->index)]
      (if (keymap? v)
          (values f (compile-keymap v))
          (values f v)))))

(fn ref [tbl keys]
  (when tbl
    (match keys
      [k1 & more] (ref (. tbl k1) more)
      [k1] (. tbl k1)
      x tbl)))

(let [v (ref {:a 1} [:a])] (assert (= v 1) v))
(let [v (ref {:a {:c 7}} [:a :c])] (assert (= v 7) v))
(let [v (ref {:a {:c 7}} [:a ])] (assert (match v {:c 7} true) (view v)))
(let [v (ref {:a {:c 7}} [:z :d])] (assert (not v) v))


(fn recogniser [source-keymap]
  (let [keymap (compile-keymap source-keymap)]
    (var key-sequence [])
    {
     :accept-event
     (fn [_ e]
       (when (not (modifier? e.keyval))
         (let [c (event->index e)]
           (table.insert key-sequence c)
           (match (ref keymap key-sequence)
             (where v (keymap? v))
             (values nil
                     (let [syms (lume.map key-sequence index->string)]
                       (table.concat syms " ")))

             (where v (command? v))
             (do
               (set key-sequence [])
               v)

             (where nil (= c "103:4"))
             (do
               (set key-sequence [])
               (values nil "cancelled"))
             _
             (let [syms (lume.map key-sequence index->string)]
               (set key-sequence [])
               (values nil (.. (table.concat syms " ") " is undefined")))))))
     }))


{ : recogniser
  :keyval (collect [_ name (ipairs [:Escape :Delete :BackSpace])]
            (values name (Gdk.keyval_from_name name)))
  :_ {
      ;; symbols in _ are exported only for testing
      : keychord->spec
      } }