robustness and appendfile

- test exit code to see if gui handle is still valid
- appendfile adds string to existent file if known,
- otherwise just as a new file

src/lib/StrictPrelude.inc

@@ -142,9 +142,11 @@ prim_readFile = ioFunc1 "prim_readFile" (extVal `dot` addReadFile)
 prim_writeFile :: String -> String -> Step (IO ())
 prim_writeFile = ioFunc2 "prim_writeFile" addWrittenFile
 
-prim_appendFile _ =  Prelude.error "" --return ()
+prim_appendFile :: String -> String -> Step (IO ())
+prim_appendFile = ioFunc2 "prim_appendFile" addAppendedFile
 
-catchFail = Prelude.error ""
+catchFail :: Step (IO a) -> Step (IO a) -> Step (IO a)
+catchFail = Prelude.error "catchFail not yet supported"
 
 prim_show :: StrictCurry a => a -> Step String
 prim_show = trace1 "prim_show" Prelude.show

src/oracle/Biotope.curry

@@ -12,25 +12,23 @@ hello= listToDeq
        \(____/()(____)()(_____)() Oracles\n\
        \---------------------------------\n\n\n"
 
-widget st lref ref cb rb wb act = Col [LeftAlign] [
-  Row [] [PlainButton [Text "Console",WRef cb,Active (act==Console),
-                       Handler DefaultEvent (showConsole st)],
-          PlainButton [Text "Files read",Active (act==ReadFiles),WRef rb,
-                       Handler DefaultEvent (showReadFile st 0)],
-          PlainButton [Text "Files written",Active (act==WrittenFiles),WRef wb,
-                       Handler DefaultEvent (showWrittenFile st 0)]],
-  Row [] [ListBox [FillY,Width 0,WRef lref,
-          Handler DefaultEvent (selectFile st)], 
-          TextEditScroll [Text $ deqToList hello,WRef ref,TclOption ""]]
+widget st lref ref cb fb act = Col [LeftAlign] [
+  row [PlainButton [Text "Console",WRef cb,Active (act==Console),
+                    Handler DefaultEvent (showConsole st)],
+       PlainButton [Text "Files",Active (act==Files),WRef fb,
+                       Handler DefaultEvent (showFile True st 0)]],
+  row [ListBox [FillY,Width 0,WRef lref,
+       Handler DefaultEvent (selectFile st)], 
+       TextEditScroll [Text $ deqToList hello,WRef ref]]
   ]
 
 
 main = do
-  let cref,rb,wb,lref,cb free
+  let cref,fb,lref,cb free
   stdinUnbuffered
-  state <- newIORef (emptyState cref rb wb lref cb)
+  state <- newIORef (emptyState cref fb lref cb)
   runInitHandlesControlledGUI "B.I.O.tope -- the debugging environment"  
-     (widget state lref cref cb rb wb Console,[readMessages state]) 
+     (widget state lref cref cb fb Console,[readMessages state]) 
      (readMessages state stdin) [stdin]
     
 
@@ -38,29 +36,27 @@ main = do
 -- the state and how to reset it
 ---------------------------------------------------------------------------
 
-data ActiveWidget = Console | ReadFiles | WrittenFiles
+data ActiveWidget = Console | Files 
 
 type Files = [(String,String)]
-type State = {readFiles, writtenFiles :: Files, 
+type State = {files :: Files, 
               console :: Queue Char,active :: ActiveWidget,
               listWidget,textWidget,
-              consoleButton,readButton,writtenButton :: WidgetRef}
+              consoleButton,fileButton :: WidgetRef}
 
-emptyState r1 r2 r3 r4 r5 = 
-  {readFiles=[],writtenFiles=[],console=hello, active=Console,
-   textWidget=r1,readButton=r2,writtenButton=r3,
-   listWidget=r4,consoleButton=r5}
+emptyState r1 r2 r3 r4 = 
+  {files=[],console=hello, active=Console,
+   textWidget=r1,fileButton=r2,
+   listWidget=r3,consoleButton=r4}
 
 
 reset :: GuiPort -> IORef State -> IO [ReconfigureItem]
 reset gp ref = do
   st <- readIORef ref
-  writeIORef ref {readFiles:=[],writtenFiles:=[],console:=hello,
-                  active:=Console|st}
+  writeIORef ref {files:=[],console:=hello,active:=Console|st}
   setValue (st->textWidget) (deqToList hello) gp
   return [WidgetConf (st->listWidget) (List []),
-          acti False (st->readButton),
-          acti False (st->writtenButton),
+          acti False (st->fileButton),
           acti False (st->consoleButton)]
 
 
@@ -81,17 +77,21 @@ addConsole gp ref c = do
                        WidgetConf (st->listWidget) (List [])]
                
 
-addReadFile :: GuiPort -> IORef State -> (String,String) -> IO [ReconfigureItem]
-addReadFile gp ref f = do
+addFile :: Bool -> GuiPort -> IORef State -> (String,String) -> IO [ReconfigureItem]
+addFile append gp ref f@(fn,cont) = do
   st <- readIORef ref
-  writeIORef ref {readFiles:=st->readFiles++[f] | st}
-  showReadFile ref (length (st->readFiles)) gp
-  
-addWrittenFile :: GuiPort -> IORef State -> (String,String) -> IO [ReconfigureItem]
-addWrittenFile gp ref f = do
-  st <- readIORef ref
-  writeIORef ref {writtenFiles:=st->writtenFiles ++ [f] | st}
-  showWrittenFile ref (length (st->writtenFiles)) gp
+  let fs = st->files
+  case break ((==tail fn) . tail . fst) fs of
+    (_,[])    -> do
+                   writeIORef ref {files:=st->files++[f] | st}
+                   showFile True ref (length (st->files)) gp
+    (xs,(y,yc):ys) -> if append 
+                 then do
+                   writeIORef ref {files:=xs++ys++[(fn,yc++cont)] | st}
+                   showFile True ref (length (st->files) - 1) gp
+                 else do 
+                   writeIORef ref {files:=xs++ys++[f] | st}
+                   showFile True ref (length (st->files) - 1) gp
 
 ---------------------------------------------------------------------------
 -- showing content in text/list widget
@@ -101,25 +101,18 @@ selectFile :: IORef State -> GuiPort -> IO [ReconfigureItem]
 selectFile ref gp = do
   st <- readIORef ref
   i  <- getValue (st->listWidget) gp
-  case st->active of
-    ReadFiles    -> showReadFile    ref (readInt i) gp
-    WrittenFiles -> showWrittenFile ref (readInt i) gp
+  showFile    False ref (readInt i) gp
 
-showReadFile :: IORef State -> Int -> GuiPort -> IO [ReconfigureItem]
-showReadFile ref i gp = do
+showFile :: Bool -> IORef State -> Int -> GuiPort -> IO [ReconfigureItem]
+showFile listchanged ref i gp = do
   st <- readIORef ref
-  setValue (st->textWidget) (snd (st->readFiles !! i)) gp
-  writeIORef ref {active:=ReadFiles|st} 
-  return [activate st,acti False (st->readButton),
-          WidgetConf (st->listWidget) (List (map fst (st->readFiles)))]
-
-showWrittenFile :: IORef State -> Int -> GuiPort -> IO [ReconfigureItem]
-showWrittenFile ref i gp = do
-  st <- readIORef ref
-  setValue (st->textWidget) (snd (st->writtenFiles !! i)) gp
-  writeIORef ref {active:=WrittenFiles|st} 
-  return [activate st,acti False (st->writtenButton),
-          WidgetConf (st->listWidget) (List (map fst (st->writtenFiles)))]
+  setValue (st->textWidget) (snd (st->files !! i)) gp
+  writeIORef ref {active:=Files|st} 
+  return (activate st:acti False (st->fileButton):
+          if listchanged 
+          then map (WidgetConf (st->listWidget)) 
+               [List (map fst (st->files)),Text (show i)]
+          else [])
 
 showConsole :: IORef State ->  GuiPort -> IO [ReconfigureItem]
 showConsole ref gp = do
@@ -131,9 +124,8 @@ showConsole ref gp = do
 
 activate :: State -> ReconfigureItem
 activate st = acti True (case st -> active of
-  ReadFiles    -> (st->readButton)
-  WrittenFiles -> (st->writtenButton) 
-  Console      -> (st->consoleButton))
+  Files   -> (st->fileButton)
+  Console -> (st->consoleButton))
 
 
 acti b ref = WidgetConf ref (Active b)
@@ -152,11 +144,15 @@ readMessages ref h gp = do
     'r' -> do
        l <- hGetLine h
        cont <- getFileCont h 
-       addReadFile gp ref (l,cont)
+       addFile False gp ref ("R: "++l,cont)
     'w' -> do
        l <- hGetLine h
        cont <- getFileCont h 
-       addWrittenFile gp ref (l,cont)
+       addFile False gp ref ("W: "++l,cont)
+    'a' -> do
+       l <- hGetLine h
+       cont <- getFileCont h 
+       addFile True gp ref ("W: "++l,cont)
     'q' -> exitGUI gp >> return []
     '!' -> reset gp ref
     _   -> return []

src/oracle/StrictSteps.hs

@@ -6,7 +6,9 @@ module StrictSteps (
   ConsTerm, consTerm, consUnderscore, consFailed,
   eval, showTerm, ($$),
   IO',Prim(..),StepPrim,
-  addConsole,addReadFile,addWrittenFile,getNextExtVal,
+  addConsole,
+  addReadFile,addWrittenFile,addAppendedFile,
+  getNextExtVal,
   pc1,pc2,pc3,pc4,pc5
   ) where
 
@@ -162,7 +164,8 @@ data DebuggerState = DebuggerState {
                                     -- Durchlauf geskippt? 
       unrated     :: BoolStack,     -- welche Funktionsaufrufe wurden bei den
                                     -- letzten Durchlufen geskippt?
-      gui         :: Maybe Handle,  -- our link to the biotope
+      gui         :: Maybe (Handle,ProcessHandle),
+                                    -- our link to the biotope
       extValues   :: [String]       -- the values from external io functions
     }
 
@@ -320,39 +323,6 @@ eval a mode
 --------------------------------------------------------- -}
 
 
-traceWithStepfile :: StrictCurry a => String -> Step a -> IO ()
-traceWithStepfile name program = do
-  state <- initState name
-  traceProgram (traceFunCall (return $ consTerm "main" []) program) state
-
-
-data Prim a = Prim ConsTerm a | PrimUnderscore | PrimFailed String
-
-instance StrictCurry (Prim a) where
-  showCons PrimUnderscore = return consUnderscore
-  showCons (PrimFailed s) = return (consFailed s)
-  showCons (Prim a _)     = return a
-
-instance Eq (Prim a) where
-  Prim x _ == Prim y _ = x Prelude.== y
-
-instance Show (Prim a) where
-  show (Prim a _) = show a
-
-type IO' a = Prim (Step a)
-type StepPrim a = Step (Prim a)
-
-runWithStepfile :: StrictCurry a => String -> Step (IO' a) -> IO ()
-runWithStepfile name action = do
-   state <- initState name
-   bug <- runErrorT $ runStateT (do Prim term act  <- action StepInteractive
-                                    b <- act StepInteractive
-                                    closeGui 
-                                    return b) state
-   hSetEcho stdin True
-   report bug
-  
-
 {-
   loadStepfile laedt eine Orakelliste aus einer Datei
   make initial output and set terminal properties
@@ -407,6 +377,36 @@ traceLoop program
           else do put $ state { unrated = reverse (skipped endState) }
                   traceLoop program)
 
+traceWithStepfile :: StrictCurry a => String -> Step a -> IO ()
+traceWithStepfile name program = do
+  state <- initState name
+  traceProgram (traceFunCall (return $ consTerm "main" []) program) state
+
+
+runWithStepfile :: StrictCurry a => String -> Step (IO' a) -> IO ()
+runWithStepfile name action = do
+   state <- initState name
+   bug <- runErrorT $ runStateT (ioLoop action) state
+   hSetEcho stdin True
+   report bug
+
+ioLoop :: Step (IO' a) -> DebugMonad a
+ioLoop action = do state <- get
+                   put $ state { skipped = emptyBoolStack }
+                   Prim term act  <- action StepInteractive
+                   b <- act StepInteractive
+                   endState <- get
+                   if sum (skipped endState) == 0
+                    then closeGui >> return b
+                    else do liftIO $ putStrLn "end reached. press any key to restart." >>
+                                     getChar
+                            resetGui 
+                            put $ state { unrated = reverse (skipped endState),
+                                          gui = gui endState }
+                            ioLoop action
+
+
+
 
 {-
   Im instrumentierten Programm sind alle Funktionsaufrufe,
@@ -535,7 +535,25 @@ showMenu menu = do state <- get
           usageLine (' ', (s, _)) = "  <SPACE>  "       ++ s
           usageLine (c,   (s,_ )) = "  "++ c:"        " ++ s
 
+---------------------------------------------------------------
+-- representation of external data types 
+---------------------------------------------------------------
+
+data Prim a = Prim ConsTerm a | PrimUnderscore | PrimFailed String
+
+instance StrictCurry (Prim a) where
+  showCons PrimUnderscore = return consUnderscore
+  showCons (PrimFailed s) = return (consFailed s)
+  showCons (Prim a _)     = return a
+
+instance Eq (Prim a) where
+  Prim x _ == Prim y _ = x Prelude.== y
+
+instance Show (Prim a) where
+  show (Prim a _) = show a
 
+type IO' a = Prim (Step a)
+type StepPrim a = Step (Prim a)
 
 ---------------------------------------------------------------
 -- saved values of external functions and their representation
@@ -551,29 +569,44 @@ getGuiHandle :: DebugMonad Handle
 getGuiHandle = do
   st <- get 
   case gui st of
-    Nothing -> do h <- liftIO $ do
-                    (h,_,_,_) <- runInteractiveCommand "biogui" 
-                    return h                  
-                  put (st{gui=Just h})
-                  return h
-    Just h  -> do op <- liftIO (hIsOpen h)
-                  if not op then put (st{gui=Nothing}) >>
-                                 getGuiHandle
-                            else return h
-
+    Nothing -> do hs <- liftIO $ do
+                    (h,_,_,ex) <- runInteractiveCommand "biotope" 
+                    return (h,ex)
+                  put (st{gui=Just hs})
+                  return (fst hs)
+    Just (h,ex)  -> do
+                    mc <- liftIO $ getProcessExitCode ex
+                    case mc of
+                      Nothing -> return h
+                      Just _  -> do
+                                   liftIO $ putStrLn "restarting biotype. old\
+                                                     \values are not available."
+                                   put (st{gui=Nothing})
+                                   getGuiHandle
 closeGui :: DebugMonad ()
-closeGui = do
+closeGui = putIfAlive 'q' 
+
+resetGui :: DebugMonad ()
+resetGui = putIfAlive '!'
+
+putIfAlive :: Char -> DebugMonad ()
+putIfAlive c = do
   st <- get 
-  maybe (return ()) (\ h -> liftIO (hPutChar h 'q' >> hClose h)) (gui st) 
+  maybe (return ()) 
+        (\ (h,ex) -> liftIO $ getProcessExitCode ex >>=
+                              maybe (hPutChar h c >> hFlush h)
+                                    (\_ -> return ())) 
+        (gui st)
 
 addConsole :: Char -> Step ()
 addConsole c = liftDebug $ do 
   h <- getGuiHandle 
   liftIO $ hPutStr h ['c',c] >> hFlush h
 
-addReadFile, addWrittenFile :: String -> String -> Step ()
-addReadFile    = addFile 'r'
-addWrittenFile = addFile 'w'
+addReadFile, addWrittenFile, addAppendedFile :: String -> String -> Step ()
+addReadFile     = addFile 'r'
+addWrittenFile  = addFile 'w'
+addAppendedFile = addFile 'a'
 
 addFile :: Char -> String -> String -> Step ()
 addFile c fn cont = liftDebug $ do