(* controller-func.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 *)

(* controller - command loops

   takes in a structure Model with signature MODEL and a structure
   View with signature VIEW, where the DATA parts of Model and View
   are identical (and so the following sharing constraints are
   satisfied), and returns a structure with signature CONTROLLER whose
   Model and View structures are Model and View, respectively *)

functor ControllerFunc(structure Model : MODEL
                       structure View : VIEW
                       sharing type Model.SymLinOrd.elem     = View.SymLinOrd.elem
                       sharing type Model.pds                = View.pds
                       sharing type Model.SymSet.set         = View.SymSet.set
                       sharing type Model.SymLexicon.lexicon = View.SymLexicon.lexicon) :>
          CONTROLLER =
struct

structure Model      = Model
structure View       = View
structure SymSet     = Model.SymSet
structure SymLexicon = Model.SymLexicon

(* reason for secondary loop terminating *)

datatype secondary = Abort | Quit | Undo

(* val secondary :
         View.vd * Model.md * Model.sym_lexicon * Model.msg * Model.pdm *
         Model.sym_set * Model.sym_set * Model.msg ->
         View.vd * Model.md * secondary

   in a call secondary(vd, md, lex, msg, pdm, olds, news, msg'), we
   require that olds is the old symbols of pdm, news is the new
   symbols of pdm, pdm is consistent with msg, and msg' is the unique
   decoding of msg (msg isn't actually needed by the code, though)

   the secondary command loop *)

fun secondary(vd, md, lex, msg, pdm, olds, news, msg') =
      case View.secondaryInput(vd, pdm, olds, news) of
           (vd, View.QuitSC)          => (vd, md, Quit)
         | (vd, View.AbortSC)         => (vd, md, Abort)
         | (vd, View.CheckSC)         =>
             (case Model.findHint(md, msg, pdm, olds, msg') of
                   (md, Model.HintDecoded)       =>
                     (View.secondaryOutput(vd, View.CheckDecodedSR), md, Abort)
                 | (md, Model.HintNotDecodable)  =>
                     secondary(View.secondaryOutput(vd, View.CheckNotDecodableSR), md,
                               lex, msg, pdm, olds, news, msg')
                 | (md, Model.HintReplace(_, _)) =>
                     secondary(View.secondaryOutput(vd, View.CheckDecodableButNotDecodedSR),
                               md, lex, msg, pdm, olds, news, msg'))
         | (vd, View.HintSC)          =>
             (case Model.findHint(md, msg, pdm, olds, msg') of
                   (md, Model.HintDecoded)       =>
                     (View.secondaryOutput(vd, View.HintDecodedSR), md, Abort)
                 | (md, Model.HintNotDecodable)  =>
                     secondary(View.secondaryOutput(vd, View.HintNotDecodableSR), md,
                               lex, msg, pdm, olds, news, msg')
                 | (md, Model.HintReplace(a, b)) =>
                     let val pdm' = Model.replace(a, b, pdm)
                     in case secondary(View.secondaryOutput(vd, View.HintReplaceSR(a, b)),
                                       md, lex, msg, pdm',
                                       SymSet.minus(olds, SymSet.fromList[a]),
                                       SymSet.union(news, SymSet.fromList[b]),
                                       msg') of
                             (vd, md, Undo) => secondary(vd, md, lex, msg, pdm, olds, news, msg')
                           | x              => x
                     end)
         | (vd, View.ReplaceSC(a, b)) =>
             let val pdm' = Model.replace(a, b, pdm)
             in case secondary(vd, md, lex, msg, pdm',
                               SymSet.minus(olds, SymSet.fromList[a]),
                               SymSet.union(news, SymSet.fromList[b]),
                               msg') of
                     (vd, md, Undo) => secondary(vd, md, lex, msg, pdm, olds, news, msg')
                   | x              => x
             end
         | (vd, View.UndoSC)          => (vd, md, Undo)

(* val primary : View.vd * Model.md * Model.sym_lexicon -> View.vd

   the primary command loop *)

fun primary(vd, md, lex) =
      case View.primaryInput vd of
           (vd, View.QuitPC)        => vd
         | (vd, View.LexiconPC lex) => primary(vd, md, lex)
         | (vd, View.EncodePC msg)  =>
             let val ps = Model.unknownWords(lex, msg)
             in if null ps
                then case View.abortable
                          (vd, 50000, fn (ab, ca) => Model.decodings(ab, ca, md, lex, msg)) of
                          (vd, md, NONE)                          => primary(vd, md, lex)
                        | (_, _, SOME Model.DecodingsNone)        =>
                            raise Fail "cannot happen"
                        | (vd, md, SOME(Model.DecodingsUnique _)) =>
                            let val (md, msg') = Model.encode(md, msg)
                            in primary(View.primaryOutput(vd, View.EncodeEncodingPR msg'),
                                       md, lex)
                            end
                        | (vd, md, SOME Model.DecodingsMultiple)  =>
                            primary(View.primaryOutput(vd, View.EncodeMultipleDecodingsPR),
                                    md, lex)
                else primary(View.primaryOutput(vd, View.EncodeWordsNotInLexiconPR ps),
                             md, lex)
             end
         | (vd, View.DecodePC msg)  =>
             (case View.abortable
                   (vd, 50000, fn (ab, ca) => Model.decodings(ab, ca, md, lex, msg)) of
                   (vd, md, NONE)                             => primary(vd, md, lex)
                 | (vd, md, SOME Model.DecodingsNone)         =>
                     primary(View.primaryOutput(vd, View.DecodeNoDecodingsPR), md, lex)
                 | (vd, md, SOME(Model.DecodingsUnique msg')) =>
                     (case secondary
                           (vd, md, lex, msg, Model.toPDM msg,
                            Model.symsMsg msg, SymSet.fromList nil, msg') of
                           (vd, _,  Quit)  => vd
                         | (vd, md, Abort) => primary(vd, md, lex)
                         | (vd, md, Undo)  => primary(vd, md, lex))
                 | (vd, md, SOME Model.DecodingsMultiple)     =>
                     primary(View.primaryOutput(vd, View.DecodeMultipleDecodingsPR),
                             md, lex))

(* val main : string * string list -> OS.Process.status

   program's main function *)

fun main(cmd, args) =
      View.run(Aux.lastPartOfPath cmd,
               args,
               fn vd => primary(vd, Model.init(), SymLexicon.empty))

end;