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

(fn keychord->spec [keychord]
  (let [Mod Gdk.ModifierType
        symbol (keychord:match "(%w+)$")
        upper? (and (symbol:match "%u") true)
        modmask (accumulate [m (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 (string.byte (symbol:lower))
     : 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 compile-keymap [input]
  (collect [k v (pairs input)]
    (let [f (-> k keychord->spec spec->index)]
      (match (type v)
        "function" (values f v)
        "table" (values f (compile-keymap v))))))

(fn recogniser [source-keymap]
  (let [keymap (compile-keymap source-keymap)]
    (var m keymap)
    {
     :accept-event
     (fn [_ e]
       (let [c (event->index e)
             v (. m c)]
         (match (type v)
           "table" (do
                     (set m v)
                     (values nil (.. c " ")))
           "function" (do
                        (set m keymap)
                        v)
           "nil" (do
                   (set m keymap)
                   (values nil (.. "No binding for " (view e) " ")))

           )))
     }))


{ : recogniser
  :_ {
      ;; symbols in _ are exported only for testing
      : keychord->spec
      } }