(local lpeg (require "lib.lulpeg.lulpeg"))

(local {: P : Cc} lpeg)

;; Maximum offset that was reached when parsing. It's updated by the M pattern,
;; which is inserted into other patterns. For the general idea, see
;; https://www.inf.puc-rio.br/~roberto/docs/lpeg-primer.pdf#page=22.
(var max-pos 0)

;; Update max-pos.
(local M (lpeg.P (fn [s i]
                   (set max-pos (math.max max-pos i))
                   true)))

;; Space characters. Also updates max-pos.
(local Sp (* M (lpeg.S " \t")))

;; Transform a pattern to match only when there's a word boundary at its
;; beginning and end.
(lambda w [patt]
  (* (^ Sp 0)     ;; 0 or more space characters,
     patt         ;; followed by the pattern,
     (+ (# Sp)    ;; followed by either a space character
        (P -1)))) ;; or end of string.

;; Transform a sequence of patterns to match in sequence, and require a word
;; boundary at the beginning and end of each constituent pattern.
(lambda W [...]
  (accumulate [patt (P true) 
               _ p (ipairs [...])]
    (* patt (w p))))

;; Transform a pattern to require consuming the full input, with optional
;; leading and trailing space.
(lambda FULL [cap patt] 
  (* (Cc cap) 
     (^ Sp 0) ;; Optional leading space.
     patt
     (^ Sp 0) ;; Optional trailing space.
     (P -1))) ;; End of line.

;; Optionally match a pattern, 0 or 1 occurrences of it.
(lambda OPT [patt]
  (^ patt -1))

(local Article
  (+ (W "a")
     (W "an")
     (* (+ (W "the")
           (W "ye"))
        (OPT (+ (W "damned")
                (W "damn"))))))

(local Bool
  (+ (* (Cc true)  (+ (W "on")  (W "yes") (W "1")))
     (* (Cc false) (+ (W "off") (W "no")  (W "0")))))

(local Compass
  (+ (* (Cc :N) (+ (W "n") (W "north")))
     (* (Cc :E) (+ (W "e") (W "east")))
     (* (Cc :S) (+ (W "s") (W "south")))
     (* (Cc :W) (+ (W "w") (W "west")))))

(local UpDown
  (+ (* (Cc :U) (+ (W "u") (W "up")))
     (* (Cc :D) (+ (W "d") (W "down")))))

(local Bearing
  (+ Compass
     UpDown
     (* (Cc :IN)  (+ (W "in")  (W "enter")))
     (* (Cc :OUT) (+ (W "out") (W "exit") (W "leave")))))

(local Knockable
  (* (OPT Article)
     (Cc :DOOR)
     (+ (W "door")
        (W "knocker"))))

;; Treat the plywood box and the lock that is on it as the same item.
(local Box
  (* (Cc :BOX)
     (+ (* (OPT (W "plywood"))
           (W "box"))
        (* (OPT (+ (W "combination")
                   (W "electronic")))
           (+ (W "lock")
              (W "keypad")
              (W "key" "pad"))))))

(local Examinable
  (* (OPT Article)
     Box))

(local Openable
  (* (OPT Article)
     (+ (* (Cc :DOOR)
           (W "door"))

        (* (Cc :TRAPDOOR)
           (W "trapdoor"))

        Box)))

(local Item
  (* (OPT Article)
     (+ (* (Cc :RADIO)
           (OPT (+ (W "battery-powered")
                   (W "battery" "powered")
                   (W "portable")))
           (+ (W "radio")
              (W "receiver")))

        (* (Cc :MUSHROOM)
           (OPT (W "mysterious"))
           (+ (W "mushroom")
              (W "toadstool")
              (W "fungus")
              (W "mush")))

        (* (Cc :SPARE-KEY)
           (OPT (+ (W "spare")
                   (W "metal")))
           (W "key"))

        (* (Cc :CAT-FOOD)
           (+ (W "cat" "food")
              (W "catfood")
              (W "food")))

        Box

        (* (Cc :CAT)
           (OPT (W "my"))
           (^ (+ (W "little")
                 (W "grey")
                 (W "gray")
                 (W "feisty")) 0)
           (+ (* (OPT (W "kitty"))
                 (+ (W "cat")
                    (W "kat")))
              (W "kitty")
              (W "feline"))))))

;; A numeric code of at least 3 digits, with optional whitespace between them.
(local NumericCode
  (W (/ (lpeg.Ct
          (^ (* (^ Sp 0)
                (lpeg.C (lpeg.R "09")))
             3))
        table.concat)))

(local RadioStation
  (lpeg.Ct (^ (* (^ Sp 0)
                 (lpeg.C (W (^ (- (P 1) Sp) 1)))) ;; 1 or more non-space characters.
              1)))

(local Command
  (+ (FULL :GO
           (+ (* UpDown (+ (W "ladder")
                           (W "stairs")
                           (W "stair")))
              (* (+ (W "go")
                    (W "walk"))
                 (+ (* (W "to" "the") Compass)
                    Bearing))
              (* (+ (W "climb" "down")
                    (W "descend"))
                 (OPT (+ (W "ladder")
                         (W "stairs")
                         (W "stair")))
                 (Cc :D))
              (* (+ (W "climb" "up")
                    (W "climb")
                    (W "ascend"))
                 (OPT (+ (W "ladder")
                         (W "stairs")
                         (W "stair")))
                 (Cc :U))
              Bearing))

     (FULL :INVENTORY
           (+ (W "inventory")
              (W "i")
              (W "take" "inventory")))

     (FULL :LOOK
           (+ (W "look")
              (W "l")))

     (FULL :EXAMINE
           (* (+ (W "examine")
                 (W "x")
                 (* (+ (W "look") (W "gaze") (W "peer")) (OPT (W "at")))
                 (W "admire")
                 (W "behold"))
              (+ Item
                 Examinable)))

     (FULL :TAKE
           (* (+ (W "take")
                 (W "get")
                 (W "pick" "up")
                 (W "grab")
                 (W "acquire"))
              Item))

     (FULL :DROP
           (* (+ (W "drop")
                 (W "discard"))
              Item))

     (FULL :KNOCK
           (* (W "knock")
              (OPT (* (W "on") Knockable))))

     (FULL :ACTIVATE
           (+ (* (+ (W "turn" "on")
                    (W "switch" "on")
                    (W "activate")
                    (W "use"))
                 Item)
              (* (OPT (+ (W "turn")
                         (W "switch")))
                 (* Item (W "on")))))

     (FULL :DEACTIVATE
           (+ (* (+ (W "turn" "off")
                    (W "switch" "off")
                    (W "deactivate")
                    (W "douse"))
                 Item)
              (* (OPT (+ (W "turn")
                         (W "switch")))
                 (* Item (W "off")))))

     ;; Listen to the room.
     (FULL :LISTEN
           (+ (* (W "listen")
                 (OPT (* (OPT (W "to"))
                         (OPT Article)
                         (+ (W "rapids")
                            (W "room")
                            (W "sounds")))))
              (W "wait")
              (W "ponder")
              (W "meditate")
              (W "pause")
              (W "sit")))

     ;; Listen to an item.
     (FULL :LISTEN
           (* (+ (* (W "listen") (OPT (W "to")))
                 (W "hear"))
              Item))

     (FULL :OPEN
           (* (+ (W "open")
                 (W "unlock"))
              Openable))

     (FULL :ENTER
           (+ NumericCode ;; Just a bare code works as a command.
              (* (+ (W "enter")
                    (W "type"))
                 (OPT (* (OPT Article) (W "code")))
                 NumericCode
                 (OPT (* (+ (W "in")
                            (W "on")
                            (W "into"))
                         Item)))
              (/ (* (+ (W "open")
                       (W "unlock"))
                    Item
                    (OPT (+ (W "with")
                            (W "using")))
                    (OPT (* (OPT Article) (W "code")))
                    NumericCode)
                 #(values $2 $1)))) ;; Swap to put the code first and item second.

     (FULL :EAT
           (* (+ (W "eat")
                 (W "nom")
                 (W "devour")
                 (W "scarf"))
              Item))

     (FULL :TUNE
           (+ (* (+ (W "tune")
                    (W "set")
                    (W "adjust")
                    (W "change"))
                 (+ Item
                    (Cc :RADIO)) ;; Default if no item is given
                 (OPT (W "station"))
                 (OPT (* (OPT (W "to")) (OPT Article)
                         RadioStation)))
              (* (OPT (W "radio"))
                 (Cc :RADIO)
                 (W "station")
                 RadioStation)))

     (FULL :FEED
           (* (+ (W "feed")
                 (W "offer")
                 (W "give"))
              (+ ;; feed cat food to the cat
                 (/ (* Item
                       (W "to")
                       Item)
                    #(values $2 $1)) ;; Swap to put the item first and the food second.
                 ;; feed cat cat food
                 (* Item
                    (OPT (W "with"))
                    Item)
                 ;; feed cat
                 Item)))

     (FULL :PET
           (* (+ (W "pet")
                 (* (W "play") (OPT (W "with"))))
              Item))

     (FULL :QUIT
           (+ (* (W "quit") (OPT (* (OPT Article) (W "game"))))
              (W "vamoose")
              (W "scram")))

     (FULL :MUTE
           (+ (* (W "mute") (Cc true))
              (* (W "unmute") (Cc false))))

     (FULL :VOLUME
           (* (W "volume")
              (OPT (+ (/ (W (^ (lpeg.R "09") 1)) tonumber)
                      (* (Cc :UP)   (W "up"))
                      (* (Cc :DOWN) (W "down"))))))

     (FULL :HELP
           (* (+ (W "help")
                 (W "halp"))
              (OPT (W "me"))
              (OPT (W "please"))))

     (FULL :DEBUG
           (* (W "debug")
              (OPT Bool)))))

(lambda parse [line]
  (set max-pos 0)
  ;; Return all captures in a sequential table, then the maximum position
  ;; reached.
  (values (lpeg.match (lpeg.Ct Command) (string.lower line))
          max-pos))

{: parse}
