open Noun

(** Effect parsing and routing *)

type blit =
  | Lin of string           (* Simple line of text *)
  | Klr of noun             (* Styled/colored text (TODO: parse structure) *)
  | Mor of blit list        (* Multiple blits *)
  | Hop of int              (* Cursor hop *)
  | Clr                     (* Clear screen *)
  | Unknown of noun         (* Unparsed blit *)

type card =
  | Blit of blit            (* Terminal output *)
  | Logo                    (* Show logo *)
  | HttpResponse of noun    (* HTTP response (TODO) *)
  | Send of noun            (* Network send (TODO) *)
  | Unknown of noun         (* Unknown card type *)

type effect = {
  wire: noun;
  card: card;
}

(** Convert atom to string if possible *)
let atom_to_string = function
  | Atom z ->
      if Z.equal z Z.zero then ""
      else
        let bits = Z.numbits z in
        let bytes = (bits + 7) / 8 in
        let buf = Bytes.create bytes in
        let z_ref = ref z in
        for i = 0 to bytes - 1 do
          let byte = Z.to_int (Z.logand !z_ref (Z.of_int 0xFF)) in
          Bytes.set buf i (Char.chr byte);
          z_ref := Z.shift_right !z_ref 8
        done;
        Bytes.to_string buf
  | Cell _ -> ""

(** Parse a blit from noun *)
let rec parse_blit = function
  | Cell (tag, rest) -> begin
      match tag with
      | Atom z when Z.equal z (Z.of_string "0x6e696c") -> (* 'lin' *)
          (* %lin format: [%lin text] where text is [flag styled] *)
          begin match rest with
          | Cell (Cell (_, text), _) ->
              let str = atom_to_string text in
              Lin str
          | _ -> Unknown rest
          end
      | Atom z when Z.equal z (Z.of_string "0x726c6b") -> (* 'klr' *)
          Klr rest
      | Atom z when Z.equal z (Z.of_string "0x726f6d") -> (* 'mor' *)
          (* %mor is a list of blits *)
          let rec parse_list acc = function
            | Atom z when Z.equal z Z.zero -> List.rev acc
            | Cell (h, t) -> parse_list (parse_blit h :: acc) t
            | _ -> List.rev acc
          in
          Mor (parse_list [] rest)
      | Atom z when Z.equal z (Z.of_string "0x706f68") -> (* 'hop' *)
          begin match rest with
          | Atom n -> Hop (Z.to_int n)
          | _ -> Unknown rest
          end
      | Atom z when Z.equal z (Z.of_string "0x726c63") -> (* 'clr' *)
          Clr
      | _ -> Unknown (Cell (tag, rest))
    end
  | Atom _ as a -> Unknown a

(** Parse a card from noun *)
let parse_card = function
  | Cell (tag, rest) -> begin
      match tag with
      | Atom z when Z.equal z (Z.of_string "0x74696c62") -> (* 'blit' *)
          Blit (parse_blit rest)
      | Atom z when Z.equal z (Z.of_string "0x6f676f6c") -> (* 'logo' *)
          Logo
      | Atom z when Z.equal z (Z.of_string "0x65736e6f7073657220707474682d") -> (* 'http-response' (partial) *)
          HttpResponse rest
      | Atom z when Z.equal z (Z.of_string "0x646e6573") -> (* 'send' *)
          Send rest
      | _ -> Unknown (Cell (tag, rest))
    end
  | Atom _ as a -> Unknown a

(** Parse a single effect [wire card] *)
let parse_effect = function
  | Cell (wire, card_noun) ->
      Some { wire; card = parse_card card_noun }
  | _ -> None

(** Parse effects list from noun *)
let rec parse_effects = function
  | Atom z when Z.equal z Z.zero -> []
  | Cell (h, t) ->
      begin match parse_effect h with
      | Some eff -> eff :: parse_effects t
      | None -> parse_effects t
      end
  | _ -> []

(** Show wire for debugging *)
let rec show_wire = function
  | Atom z when Z.equal z Z.zero -> "~"
  | Cell (Atom a, rest) ->
      "/" ^ atom_to_string (Atom a) ^ show_wire rest
  | Cell (h, t) ->
      "/" ^ show_noun h ^ show_wire t
  | Atom a -> "/" ^ atom_to_string (Atom a)

and show_noun = function
  | Atom z -> Z.to_string z
  | Cell (h, t) -> "[" ^ show_noun h ^ " " ^ show_noun t ^ "]"

(** Show card for debugging *)
let show_card = function
  | Blit (Lin s) -> Printf.sprintf "%%blit %%lin %S" s
  | Blit (Mor bs) -> Printf.sprintf "%%blit %%mor (%d blits)" (List.length bs)
  | Blit Clr -> "%blit %clr"
  | Blit (Hop n) -> Printf.sprintf "%%blit %%hop %d" n
  | Blit (Klr _) -> "%blit %klr (...)"
  | Blit (Unknown _) -> "%blit (unknown)"
  | Logo -> "%logo"
  | HttpResponse _ -> "%http-response"
  | Send _ -> "%send"
  | Unknown _ -> "(unknown card)"

(** Filter effects by wire pattern *)
let is_dill_wire = function
  | Cell (Atom d, Cell (Atom term, _)) ->
      Z.equal d (Z.of_int (Char.code 'd')) &&
      Z.equal term (Z.of_string "0x6d726574") (* 'term' *)
  | _ -> false

let is_http_wire = function
  | Cell (Atom g, _) ->
      Z.equal g (Z.of_int (Char.code 'g'))
  | _ -> false

let is_ames_wire = function
  | Cell (Atom a, _) ->
      Z.equal a (Z.of_int (Char.code 'a'))
  | _ -> false