questions about the IO library

Matt Fairtlough m.fairtlough@dcs.shef.ac.uk
Wed, 9 Jun 1999 15:06:44 +0100 (BST)



/* some questions about the IO library 0.8
   I will be most grateful for any illumination!
   These are in the form of comments in the following module.
*/

module questions

/* My main question is this: how can you display a component of state
   without simultaneously overwriting the state with a value that does not
   depend on the original state, i.e. by performing a destructive read?
   Is it even _possible_ with CommandDialogs?  The functions lookDestroy
   and lookSave (misnamed!) below are two attempts, but both reset the
   state to fixed values.

   I've thought hard about this and tried a number of approaches; it looks
   impossible to me but the database example should explain how, only I have
   not been able to fathom it.  Is there any way of recovering the state from
   a value of type *IO?  Why is *IO parameterised over the type of states in
   the first place?  Is it possible to explain in a few words how the callback 
   functions in menus, windows and dialogs actually work, or do I need to read
   the sources?

   My next question is: is it possible to adopt a monadic style of 
   interface programming with the IO library 0.8 (or 1.01)?  If so, it would
   be nice to see some examples of whole programs. It is mentioned in
   the Clean book, but I don't think the examples there work with either library.
   
   Why do I get lots of messages of the form:
   Warning [questions.icl,_match5]: function may fail
   when compiling this module?

   Finally, why is the Ok button highlighted in the dialog called by lookSave 
   below, which does not specify the button Id of the Ok button, but another 
   instead?  It does not seem to be possible to specify that _no_ button be
   highlighted in the dialog for selection when return is pressed.
*/

/* trial system has two components: a string and an integer
*/
:: State = {string::String,integer::Int}
:: *IO :== IOState *State

import StdEnv
import deltaEventIO, deltaDialog, deltaIOSystem, deltaMenu, deltaWindow, deltaFont
import deltaPicture
import deltaIOState, deltaFileSelect, deltaControls, deltaSystem

Cancel    :==    "Cancel"
OK        :==    "Ok"
DoNotCareId :== 0

/* inp is (modified) from the database example
*/
inp :: 
    String  
    (String -> .(*a -> .((*IOState *a) -> *(*a,*IOState *a)))) 
    .b *(IOState *a) -> *(.b,*IOState *a); 
inp name fun s io
 =    (s, OpenDialog dialogdef io)
where
    dialogdef    = CommandDialog dlgId name [] okId
                    [ StaticText nameId Left (name+++": ")
                    , EditText inputId (RightTo nameId) (Inch 4.0) 1 ""
                    , DialogButton okId (Below inputId) OK Able ok
                    ]
    ok dlginfo s io    = fun (GetEditText inputId dlginfo) s (CloseDialog dlgId io)
    [dlgId,nameId,inputId,okId:_]    = [1000..]

setString :: String .State -> .State
setString val s = {s & string=val}

setInteger :: Int .State -> .State
setInteger val s = {s & integer=val}

incr :: .State -> .State
incr s = {s & integer=s.integer+1}

setState1  = inp "Set string to new value" (\val s io -> (setString val s, io))
setState2  = inp "Set integer to new value" (\val s io -> (setInteger (toInt val) s, io))
setState3  = inp "Increment integer (ignoring input)" (\_ s io -> (incr s, io))

next val1 = inp ("Extend "+++val1) (\val2 s io -> (setString (val1+++val2) s, io))
setState4 = inp "First argument" (\val1 s io -> next val1 s io)

// which function takes control? 
test s io = (new_s, new_io)
where
 new_s = setString "direct path" (setInteger 42 s)
 new_io = OpenDialog dialog io
 dialog = CommandDialog dlgId "Input string" [] okId
           [ StaticText nameId Left "Input string: "
           , EditText inputId (RightTo nameId) (Inch 4.0) 1 "default"
           , DialogButton okId (Below inputId) OK Able ok
           ]
 ok dlginfo s io = ({s & string="callback path"}, CloseDialog dlgId io)
 [dlgId,nameId,inputId,okId : _] = [2000..]
// Answer: _both_ affect state, with new_s `happening' first if Ok is pressed.
// The state is modified as soon as test is called (new_s is evaluated eagerly
// though I do not understand why).

// destructive look at state
lookDestroy s io = ({initState & string="Destroyed by dialog alone"}, 
                    OpenDialog dialog io)
where
 dialog = CommandDialog dlgId "Look at state with lookDestroy" [] okId 
           [ StaticText nameId Left 
             ("String is: "+++s.string+++" ; integer is: "+++(toString s.integer))
           ,  DialogButton okId (Below nameId) OK Able ok
           ]
 ok dlginfo s io = ({s & string="Destroyed by Ok button"}, CloseDialog dlgId io)
 [dlgId,okId,nameId : _] = [3000..]
// if initState is replaced by s in line 1 of lookDestroy, the uniqueness type
// constraints are broken; it is hard to see how to get around this.

// another destructive look at state
lookSave s io = ({initState & string="Not saved!"}, new_io)
where
 new_io = OpenDialog dialog io
 dialog = CommandDialog dlgId "Peek at string with lookSave" [] DoNotCareId
           [ StaticText nameId Left ("String is: "+++(s.string))
           , DialogButton okId (Below nameId) OK Able ok
           ]
 ok dlginfo s io = ({s & string="lookSave Ok pressed"}, CloseDialog dlgId io)
 [dlgId,nameId,okId : _] = [2000..]

initState = {string="init", integer=0}

Start :: *World -> *World
Start world
= snd(StartIO [menus] initState [] world)
where
  menus    = MenuSystem [file, act]
  file    = PullDownMenu DoNotCareId "File" Able
        [MenuItem DoNotCareId "Quit" (Key 'q') Able Quit]
  act    = PullDownMenu DoNotCareId "Act" Able
        [  MenuItem DoNotCareId "Set string" NoKey Able setState1
        ,  MenuItem DoNotCareId "Set integer" NoKey Able setState2
        ,  MenuItem DoNotCareId "Increment" NoKey Able setState3
        ,  MenuItem DoNotCareId "Set string in two steps" NoKey Able setState4
        ,  MenuItem DoNotCareId "Test control" NoKey Able test
        ,  MenuItem DoNotCareId "Look at state (destructively)"  NoKey Able lookDestroy
        ,  MenuItem DoNotCareId "Look at string (destructively)" NoKey Able lookSave
        ]
  Quit s io = (s, QuitIO io)