updates
[mTask.git] / miTask.icl
index 1fc0b2f..ab37901 100644 (file)
@@ -3,36 +3,44 @@ module miTask
 import StdDebug, StdMisc
 
 from Text import class Text(concat,join,split), instance Text String
+from Control.Monad import mapM
 
 import iTasks
 import mTask
 
+derive class iTask MTaskMessage
+
 Start :: *World -> *World
-Start world = startEngine (withShared ([], False, [], False) mTaskTask) world
+Start world = startEngine (
+       withShared ([], False, [], False) (\ch->
+               enterInformation "Port Number?" [] >>= \port->mTaskTask port ch
+       )) world
 //Start world = startEngine mTaskTask world
 
-mTaskTask :: (Shared ([String],Bool,[String],Bool)) -> Task ()
-mTaskTask ch =
-       syncNetworkChannel "localhost" 8124 "\n" id id ch ||- 
-       viewSharedInformation "channels" [ViewWith lens] ch ||-
-       sendString (makemTask 500 bc) ch @! ()
+mTaskTask :: Int (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task ()
+mTaskTask port ch =
+       syncNetworkChannel "localhost" port "\n" decode encode ch ||-
+       (
+               sendMsg msgs ch >>= \_->
+               viewSharedInformation "channels" [ViewWith lens] ch @! ()
+       ) >>* [OnAction ActionFinish (always shutDown)]
        where
-               lens :: ([String],Bool,[String],Bool) -> String
-               lens (r,_,s,_) = "channels"
+               lens :: ([MTaskMessage],Bool,[MTaskMessage],Bool) -> ([String], [String])
+               lens (r,_,s,_) = (f r, f s)
+                       where
+                               f [] = []
+                               f [MTEmpty:xs] = f xs
+                               f [x:xs] = [toString x:f xs]
 
-               bc :: Main (ByteCode Int Expr)
-               bc = sds \x=0 In {main = x =. x +. lit 1}
+               msgs = toMessages 500 (toRealByteCode (unMain bc))
 
-makemTask :: Int (Main (ByteCode a Expr)) -> String
-makemTask to bc
-# (bc, st) = toRealByteCode (unMain bc)
-= "t" +++ toString (toChar (to / 265))
-       +++ toString (toChar (to rem 265)) +++ toString bc +++ "\n"
+               bc :: Main (ByteCode Int Stmt)
+               bc = sds \x=0 In {main = x =. x +. lit 1 :. pub x}
 
-sendString :: String (Shared ([String],Bool,[String],Bool)) -> Task ()
-sendString m ch = upd (\(r,rs,s,ss)->(r,rs,s ++ [m],ss)) ch @! ()
+sendMsg :: [MTaskMessage] (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task ()
+sendMsg m ch = upd (\(r,rs,s,ss)->(r,rs,s ++ m,ss)) ch @! ()
 
-syncNetworkChannel :: String Int String (String -> m) (m -> String) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
+syncNetworkChannel :: String Int String (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
 syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
        = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
        where
@@ -50,17 +58,17 @@ syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
                onDisconnect l (received,receiveStopped,send,sendStopped)
                        = (Ok l,Just (received,True,send,sendStopped))
 
-consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
-consumeNetworkStream processTask channel
-       = ((watch channel >>* [OnValue (ifValue ifProcess process)]) <! id) @! ()
-       where
-               ifProcess (received,receiveStopped,_,_)
-                       = receiveStopped || (not (isEmpty received))
-
-               process (received,receiveStopped,_,_)
-                       =   upd empty channel
-                       >>| if (isEmpty received) (return ()) (processTask received)
-                       @!  receiveStopped
-               
-               empty :: ([m],Bool,[m],Bool) -> ([m],Bool,[m],Bool)
-               empty (_,rs,s,ss) = ([],rs,s,ss)
+//consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
+//consumeNetworkStream processTask channel
+//     = ((watch channel >>* [OnValue (ifValue ifProcess process)]) <! id) @! ()
+//     where
+//             ifProcess (received,receiveStopped,_,_)
+//                     = receiveStopped || (not (isEmpty received))
+//
+//             process (received,receiveStopped,_,_)
+//                     =   upd empty channel
+//                     >>| if (isEmpty received) (return ()) (processTask received)
+//                     @!  receiveStopped
+//             
+//             empty :: ([m],Bool,[m],Bool) -> ([m],Bool,[m],Bool)
+//             empty (_,rs,s,ss) = ([],rs,s,ss)