(* terminal-view.sml *)

(* Copyright (C) 2008 Alley Stoughton

   This file is part of crypto, a cryptogram encoder/decoder.  See the
   file COPYING.txt for copying and usage restrictions *)

(* terminal view *)

structure View :>
            VIEW
              where type SymLinOrd.elem     = Data.sym
              and   type pds                = Data.pds
              and   type SymSet.set         = Data.SymSet.set
              and   type SymLexicon.lexicon = Data.SymLexicon.lexicon =
struct

open Data

structure LW = LowercaseWord

datatype primary_command =
           QuitPC
         | LexiconPC of sym_lexicon
         | EncodePC of msg
         | DecodePC of msg

datatype primary_response =
           EncodeWordsNotInLexiconPR of (int * word)list
         | EncodeMultipleDecodingsPR
         | EncodeEncodingPR of msg
         | DecodeNoDecodingsPR
         | DecodeMultipleDecodingsPR

datatype secondary_command =
           QuitSC
         | AbortSC
         | CheckSC
         | HintSC
         | ReplaceSC of sym * sym
         | UndoSC

datatype secondary_response =
           CheckNotDecodableSR
         | CheckDecodedSR
         | CheckDecodableButNotDecodedSR
         | HintNotDecodableSR
         | HintDecodedSR
         | HintReplaceSR of sym * sym

(* val wordToStr : word -> string

   convert a word to a string *)

fun wordToStr [b]       = str b
  | wordToStr (b :: bs) = str b ^ wordToStr bs
  | wordToStr nil       = raise Fail "cannot happen"

(* val lineToStr : line -> string

   convert a line to a string *)

fun lineToStr nil       = ""
  | lineToStr [x]       = wordToStr x
  | lineToStr (x :: xs) = wordToStr x ^ " " ^ lineToStr xs

(* val printMsg : msg -> unit

   print a message on the standard output *)

fun printMsg nil       = ()
  | printMsg (x :: xs) = (print(lineToStr x); print "\n"; printMsg xs)

(* val pdsToStr : pds -> string

   convert a pds to a string, using lowercase letters for old symbols,
   and uppercase letters for new symbols *)

fun pdsToStr(Old a) = str a
  | pdsToStr(New a) = str(Char.toUpper a)

(* val pdwToStr : pdw -> string

   convert a pdw to a string, using lowercase letters for old symbols,
   and uppercase letters for new symbols *)

fun pdwToStr [x]       = pdsToStr x
  | pdwToStr (x :: xs) = pdsToStr x ^ pdwToStr xs
  | pdwToStr nil       = raise Fail "cannot happen"

(* val pdlToStr : pdl -> string

   convert a pdl to a string, using lowercase letters for old symbols,
   and uppercase letters for new symbols *)

fun pdlToStr nil       = ""
  | pdlToStr [x]       = pdwToStr x
  | pdlToStr (x :: xs) = pdwToStr x ^ " " ^ pdlToStr xs

(* val printPDM : pdm -> unit

   print a pdm, using lowercase letters for old symbols, and uppercase
   letters for new symbols *)

fun printPDM nil       = ()
  | printPDM (x :: xs) = (print(pdlToStr x); print "\n"; printPDM xs)

(* val lexicon : string -> sym_lexicon option

   if file can't be opened for input, then lexicon file returns NONE,
   after printing an error message

   otherwise, lexicon returns SOME lex, where lex is a sym_lexicon
   representing the contents of file

   non-words in the file are ignored, except that warning messages are
   issued *)

fun lexicon file =
      let val (lex, warns) =
                LW.processFile
                (SymLexicon.empty,
                 fn (x, lex) => SymLexicon.add(explode x, lex),
                 fn lex => lex,
                 fn lex => lex,
                 LW.initError,
                 LW.wordError,
                 LW.newlineError,
                 LW.eofError)
                file
      in if null warns
         then ()
         else (print("warning: non-words in lexicon:\n");
               app (fn (n, x) =>
                         print("  line " ^ Int.toString n ^ ": \"" ^
                               String.toString x ^ "\"\n"))
                   warns);
         SOME lex
      end
        handle UnableToOpenFile =>
                 (print "unable to open file \"";
                  print(String.toString(file)); print "\"\n";
                  NONE)

(* commands *)

datatype cmd =
           EOFCmd
         | IllegalCmd
         | LegalCmd of string * string list  (* command name and arguments *)

(* val getCommand : unit -> cmd 

   getCommand() tries to read a line from the standard input

   if end-of-file has been reached, it returns EOFCmd

   otherwise, if the contents of the line contains no non-whitespace
   characters, then it returns IllegalCmd

   otherwise, it returns LegalCmd(y, ys), where y is the command's
   name and ys is the list of command arguments *)

fun getCommand() =
       case TextIO.inputLine TextIO.stdIn of
            NONE   => EOFCmd
          | SOME x =>
              case String.tokens Char.isSpace x of
                   nil     => IllegalCmd
                 | y :: ys => LegalCmd(y, ys)

(* val getMessage : unit -> msg option

   reads a message from the standard input; messages are terminated by
   lines of the form ".\n"; message input is aborted by typing a line
   of the form "!\n"; if the message contains non-words, approprate
   error messages are issued, and NONE is returned; otherwise SOME of
   the message is returned *)

fun getMessage() =
      let val _           =
                print("enter message, terminated by line with just \".\"; " ^
                      "abort by line with just \"!\"\n-----\n")
          val (msg, errs) =
                LW.processStream
                (true,
                 LW.initNormal, LW.wordNormal, LW.newlineNormal, LW.eofNormal,
                 LW.initError, LW.wordError, LW.newlineError, LW.eofError)
                TextIO.stdIn
      in if null errs
         then SOME msg
         else (print "message contains non-words:\n";
               app (fn (n, x) =>
                         print("  line " ^ Int.toString n ^ ": \"" ^
                         String.toString x ^ "\"\n"))
                   errs;
               NONE)
      end
        handle LowercaseWord.Abort => (print "aborted\n"; NONE)

(* view data *)

type vd = unit

(* val primaryComplete : string -> Completion.result

   do completion relative to the set of primary command names *)

val primaryComplete =
      Completion.complete
      (StringSet.fromList["quit", "lexicon", "encode", "decode", "help"])

(* val primaryHelp : unit -> unit *)

fun primaryHelp() =
      print("primary commands (can abbreviate to unambiguous prefix):\n" ^
            "  quit\n"                                                   ^
            "  lexicon FILE\n"                                           ^
            "  encode\n"                                                 ^
            "  decode\n"                                                 ^
            "  help\n")

fun primaryInput vd =
      (print "primary command > ";
       case getCommand() of
            EOFCmd          => (print "\n"; (vd, QuitPC))
          | IllegalCmd      => 
              (print "illegal primary command\n"; primaryInput vd)
          | LegalCmd(x, ys) =>
              case primaryComplete x of
                   Completion.None             =>
                     (print "unrecognized primary command name\n";
                      primaryInput vd)
                 | Completion.Ambiguous        =>
                     (print "ambiguous primary command name abbreviation\n";
                      primaryInput vd)
                 | Completion.Unique "quit"    =>
                     if null ys
                     then (vd, QuitPC)
                     else (print "illegal quit command\n"; primaryInput vd)
                 | Completion.Unique "lexicon" =>
                     (case ys of
                           [file] =>
                             (case lexicon file of
                                   NONE    => primaryInput vd
                                 | SOME tr => (vd, LexiconPC tr))
                         | _      =>
                             (print "illegal lexicon command\n";
                              primaryInput vd))
                 | Completion.Unique "encode"  =>
                     if List.null ys
                     then case getMessage() of
                               NONE     => primaryInput vd
                             | SOME msg => (vd, EncodePC msg)
                     else (print "illegal encode command\n"; primaryInput vd)
                 | Completion.Unique "decode"  =>
                     if List.null ys
                     then case getMessage() of
                               NONE     => primaryInput vd
                             | SOME msg => (vd, DecodePC msg)
                     else (print "illegal decode command\n"; primaryInput vd)
                 | Completion.Unique "help"    =>
                      (primaryHelp(); primaryInput vd)
                 | Completion.Unique _         => raise Fail "cannot happen")

(* val secondaryComplete : string -> Completion.result

   do completion relative to the set of secondary command names *)

val secondaryComplete =
      Completion.complete
      (StringSet.fromList["quit", "abort", "check", "hint", "replace",
                          "undo", "help"])

(* val secondaryHelp : unit -> unit *)

fun secondaryHelp() =
      print("secondary commands (can abbreviate to unambiguous prefix):\n" ^
            "  quit\n"                                                     ^
            "  abort\n"                                                    ^
            "  check\n"                                                    ^
            "  hint\n"                                                     ^
            "  replace LOWERCASE-LETTER LOWERCASE-LETTER\n"                ^
            "  undo\n"                                                     ^
            "  help\n")

fun secondaryInput(args as (vd, pdm, olds, news)) =
      (print "-----\n"; printPDM pdm; print "-----\nsecondary command >> ";
       case getCommand() of
            EOFCmd          => (print "\n"; (vd, QuitSC))
          | IllegalCmd      => 
              (print "illegal secondary command\n";
               secondaryInput args)
          | LegalCmd(x, ys) =>
              case secondaryComplete x of
                   Completion.None             =>
                     (print "unrecognized secondary command name\n";
                      secondaryInput args)
                 | Completion.Ambiguous        =>
                     (print "ambiguous secondary command name abbreviation\n";
                      secondaryInput args)
                 | Completion.Unique "quit"    =>
                     if null ys
                     then (vd, QuitSC)
                     else (print "illegal quit command\n";
                           secondaryInput args)
                 | Completion.Unique "abort"   =>
                     if null ys
                     then (vd, AbortSC)
                     else (print "illegal abort command\n";
                           secondaryInput args)
                 | Completion.Unique "check"   =>
                     if null ys
                     then (vd, CheckSC)
                     else (print "illegal check command\n";
                           secondaryInput args)
                 | Completion.Unique "hint"    =>
                     if null ys
                     then (vd, HintSC)
                     else (print "illegal hint command\n";
                           secondaryInput args)
                 | Completion.Unique "replace" =>
                     (case ys of
                           u :: [v] =>
                             (case (explode u, explode v) of
                                   ([a], [b]) =>
                                     if not(Char.isLower a)
                                       then (print "\"";
                                             print(Char.toString a);
                                             print "\" isn't lowercase ";
                                             print "letter\n";
                                             secondaryInput args)
                                     else if not(SymSet.memb(a, olds))
                                       then (print "letter \"";
                                             print(Char.toString a);
                                             print "\" isn't lowercase ";
                                             print "letter in pdm\n";
                                             secondaryInput args)
                                     else if not(Char.isLower b)
                                       then (print "\"";
                                             print(Char.toString b);
                                             print "\" isn't lowercase ";
                                             print "letter\n";
                                             secondaryInput args)
                                     else if SymSet.memb(b, news)
                                       then (print "letter \"";
                                             print(Char.toString b);
                                             print "\" appears in uppercase ";
                                             print "form in pdm\n";
                                             secondaryInput args)
                                     else (vd, ReplaceSC(a, b))
                                 | _          =>
                                     (print "illegal replace command\n";
                                      secondaryInput args))
                         | _        =>
                             (print "illegal replace command\n";
                              secondaryInput args))
                 | Completion.Unique "undo"    =>
                     if null ys
                     then (vd, UndoSC)
                     else (print "illegal undo command\n";
                           secondaryInput args)
                 | Completion.Unique "help"    =>
                     (secondaryHelp(); secondaryInput args)
                 | Completion.Unique _         => raise Fail "cannot happen")

fun primaryOutput(vd, resp) =
      case resp of
           EncodeWordsNotInLexiconPR ps =>
             (print "message has words not in lexicon:\n";
              app (fn (n, x) =>
                        print("  line " ^ Int.toString n ^ ": \"" ^
                              wordToStr x ^ "\"\n"))
                  ps;
              vd)
         | EncodeMultipleDecodingsPR    =>
             (print "message has multiple decodings\n"; vd)
         | EncodeEncodingPR msg         =>
             (print "-----\n"; printMsg msg; print "-----\n"; vd)
         | DecodeNoDecodingsPR          =>
             (print "message has no decodings\n"; vd)
         | DecodeMultipleDecodingsPR    =>
             (print "message has multiple decodings\n"; vd)

fun secondaryOutput(vd, resp) =
      case resp of
           CheckNotDecodableSR           => (print "pdm is not decodable\n"; vd)
         | CheckDecodedSR                => (print "pdm is decoded\n"; vd)
         | CheckDecodableButNotDecodedSR =>
             (print "pdm is decodable but not decoded\n"; vd)
         | HintNotDecodableSR            => (print "pdm is not decodable\n"; vd)
         | HintDecodedSR                 => (print "pdm is decoded\n"; vd)
         | HintReplaceSR(a, b)           =>
             (print "replacing "; print(str a); print " by ";
              print(str b); print "\n"; vd)

type abort = vd * IntInf.int

fun abortable(vd, n, f) =
      let (* val checkAbort : abort -> abort * bool *)

          fun checkAbort(vd, m) =
                if m > 0 andalso m mod (IntInf.fromInt n) = 0
                then (print("\rcompleted " ^ IntInf.toString m ^ " steps ...");
                      if Interrupts.check()
                      then ((vd, m), true)
                      else ((vd, m + 1), false))
                else ((vd, m + 1), false)

          val _ = print "computing ..."
      in case Interrupts.track(fn () => f((vd, 0 : IntInf.int), checkAbort)) of
              ((vd, m), u, NONE) =>
                (print("\rinterrupted after completing " ^ IntInf.toString m ^ " steps\n");
                 (vd, u, NONE))
            | ((vd, m), u, x)    =>
                (print("\rterminated after completing " ^ IntInf.toString m ^ " steps\n");
                 (vd, u, x))
      end

fun run(cmd, args, f) =
      (if null args
       then (print "at a prompt, type \"help\" for help\n";
             Interrupts.ignore f; OS.Process.success)
       else (print(cmd ^ ": usage: " ^ cmd ^ "\n"); OS.Process.failure))

end;