
type BlankLine

open Printf
open Pxp_yacc
open Pxp_document


type t = (card * int) list

and card = {
    front : string;
    back : string;
}

type filetype = Granule | Cardflasher

let empty = []
                
let get_cards deck = deck
                    
let add (newcard, newlevel) deck = 
    (List.remove_assoc newcard deck) @ [newcard, newlevel]
        
let mem card deck = List.mem_assoc card deck

let filter f deck = List.filter f deck

let merge (deck1:t) (deck2:t) =
    List.fold_right
        (fun (card,level) li -> 
             if mem card li then li 
             else add (card,level) li)
        deck2
        deck1
        
(* TODO *)
let flip deck = 
    List.map
        (fun (card, level) ->
             {front = card.back; back = card.front}, level)
        deck


(*
  Googled up this, which is linear and truly
  equal prob for each possibility:
  for(i = 0; i < 52; i++) {
    j = i + (random() % (52 - i));
    tmp = card[i];
	card[i] = card[j];
	card[j] = tmp;
  }
*)
let shuffle deck = 
    let deck_array = Array.of_list deck in
    let len = Array.length deck_array in
    for i = 0 to len - 1 do
        let j = i + (Random.int (len - i)) in
        let tmp = deck_array.(i) in
        deck_array.(i) <- deck_array.(j);
        deck_array.(j) <- tmp
    done;
    Array.to_list deck_array
    
                       
module Granule = struct
    class warner =
    object 
        method warn w =
            print_endline ("WARNING: " ^ w)
    end
    ;;
    
    let card_of_xmlnode xmlnode =
        let frontr, backr = ref "", ref "" in
        List.iter 
            (fun child ->
                 match child # node_type with
                     | T_element "front" -> frontr := child # data
                     | T_element "back" -> backr := child # data
                     | _ -> ())
            
            (xmlnode # sub_nodes);
        
        {front = !frontr; back = !backr}, 0
end
   

let of_list li =
    List.fold_right add li empty

module RecordFormatParser = struct
    type token = BlankLine | TextLine of string | SectionEnd | CardEnd
    type token_data = {
        line : int (* just a line number for now *)    
    }
            
    module StringMap = Map.Make(String)
        
    let rec parse_deck tokenstream = 
        let linenum = 
            match Stream.peek tokenstream with
                | Some (tok,data) -> Some data.line
                | None -> None
        in
        try
            match tokenstream with parser
                | [< c = parse_card; 
                     'CardEnd, data ?? "No card terminator."; 
                     d = parse_deck ?? "deck" >] -> 
                      c::d
                | [< >] -> []
        with
            | Stream.Error msg -> 
                  failwith (match linenum with
                            | None -> 
                                  sprintf "Parsing error at EOF: %s\n%!" msg
                            | Some i -> 
                                  sprintf "Parsing error near line %i: %s\n%!" 
                                        i msg)
              
and parse_card stream = 
    match stream with parser
        | [< front = parse_section; 
             '(SectionEnd, data) ?? "Card front begun, but no section \
                                     end marker found"; 
             back = parse_section; 
             map = parse_end >] -> (
                  let level = 
                      try int_of_string (StringMap.find "level" map) 
                      with
                          | Not_found -> 0
                          | _ -> 0 (* TODO: eprint err msg *)
                  in
                  {front=front; back=back}, level
          )

and parse_end stream = 
    match stream with parser
    | [< 'SectionEnd, data; 
         misc_sect = parse_assoc_section ?? "end" >] 
        -> misc_sect
    | [< >] -> StringMap.empty
          
(* Ignore leading whitespace before a section starts - TODO put this in the
   ad-hoc lexer *)
and parse_section = parser
    | [< 'Line "", data; 
         sect = parse_section ?? "section" >] -> sect
                
    | [< 'Line s, data; 
         sect = parse_section_tail ?? "section" >] -> sprintf "%s%s" s sect

and parse_section_tail = parser
    | [< 'Line s, data; sect = parse_section_tail ?? "section_tail" >] -> 
          sprintf "\n%s%s" s sect
    | [< >] -> ""
              
(* TODO: use utf-aware stuff in assoc section rather than Str, but
   since for now only the program edits it... *)
and parse_assoc_section stream = 
    match stream with parser
    | [< 'Line s, data; map = parse_assoc_section ?? "assoc_sect" >] -> 
          (
              match Str.split (Str.regexp "[ \t]*:[ \t]*") s with
                  | [name; value] -> StringMap.add name value map
                  | _ -> 
                        eprintf "WARNING: Ignoring malformed line %i\n%!" 
                              data.line; 
                        map
          )
                
    | [< >] -> StringMap.empty

        

module SimpleFormatParser = struct
    type token = BlankLine | TextLine of string

    let deck = parser
        | [< first = card; rest = deck_tail >] -> first :: rest
        | [< >] -> []

    and deck_tail = parser
        | [< _ = blanks; deck >] -> deck
        | [< >] -> []

    and blanks = parser
        | [< 'BlankLine; _ = blanks >] -> ()
        | [< >] -> ()

    and card = parser
        | [< 'TextLine s; backlines = lines >] -> {front = s;
                                                   back = String.concat "" 
                                                              backtext}
              
    and lines = parser
        | [< 'Textline s; rest = lines >] -> s :: rest
        | [< >] -> ""
end

let of_simple_channel inchan =
    let linenum = ref 0 in
    let state = ref WaitingForText in

    (* We are going to hold the entire file contents in
       memory anyhow, so it is ok to just read the whole thing *)
    let lines = input_all_lines inchan in

    List.fold_left
        (fun line (li, state) ->
             match state, line with
                 | WaitingForText, "" -> li, state
                 | WaitingForText, s -> 
             

    parse_deck (Stream.from
                    (fun _ ->
                         try Some (
                             let line, num = next_nonempty_line inchan in
                             linenum := num;
                             let info = {line = !linenum} in
                             
                             

                             match !state with
                                 | WaitingForText ->
                                       let info = {line = !linenum} in
                                       (match input_line inchan with
                                            | "" -> Line "", info
                                            | s -> 
                                                  state := JustReadFirst;
                                                  Line s, info)
                                             
                                 | JustReadFirst -> 
                                       let info = {line = !linenum} in
                                       SectionEnd, info

                                 | ReadingSecond ->
                                       linenum := !linenum + 1;
                                       let info = {line = !linenum} in
                                       (match input_line inchan with
                                            | "" ->
                                                  state := WaitingForText;
                                                  CardEnd, info
                                            | s -> Line s, info))
                         with
                             | End_of_file -> None))
        
let of_record_channel inchan =
    let linenum = ref 0 in
    parse_deck (Stream.from 
                    (fun _ -> 
                         try Some (
                             linenum := !linenum + 1;
                             let info = {line = !linenum} in
                             match input_line inchan with
                                 | "%%" -> SectionEnd, info
                                 | "%%%%" -> CardEnd, info
                                 | s -> Line s, info)
                         with
                             | End_of_file -> None))
        
let of_granule_channel inchan =
    let xmldoc = parse_document_entity 
                     {default_config with 
                          warner = new Granule.warner;
                          encoding = `Enc_utf8;
                          disable_content_validation = true}
                     (from_channel ~id:(Pxp_types.System ".") inchan)
                     default_spec
    in
    let children = xmldoc # root # sub_nodes in
              
              List.fold_right
                  (fun nextchild decktail ->
                       match nextchild # node_type with
                           | T_element "card" -> 
                                 (Granule.card_of_xmlnode nextchild) ::
                                       decktail
                           | _ -> decktail)
                  children
                  empty
        

let of_channel in_channel =
    eprintf "Trying as simple file.\n%!";
    try of_simple_channel in_channel
    with simple_exception -> ();
        eprintf "Could not load as simple file:\n%s\n\
                 Trying as record file.\n%!"
            (Printexc.to_string simple_exception);
        seek_in in_channel 0;

        try of_record_channel in_channel
        with record_exception -> ();
            eprintf "Could not load a record file:\n%s\n\
                     Trying as granule file.\n%!"
                (Printexc.to_string record_exception);
            seek_in in_channel 0;
            
            try of_granule_channel in_channel
            with granule_exception -> ();
                eprintf "Could not load as granule file:\n%s\n\
                         Giving up.\n%!"
                    (Pxp_types.string_of_exn granule_exception);
                exit 1

let of_filename filename =
    let in_channel = open_in filename in
    eprintf "Opening %s\n" filename;
    of_channel in_channel

(*
  ~filetype:(if Filename.check_suffix filename ".dkf"
  then Granule else Cardflasher)
*)

let to_channel outchan deck =
    List.iter 
        (fun (card, level) -> ();
             fprintf outchan "%s\n%%%%\n%s\n%%%%\nlevel: %i\n%%%%%%%%\n"
                 card.front card.back level)
        deck
