miTask.icl

   1 module miTask
   2
   3 import StdDebug, StdMisc
   4
   5 from Text import class Text(concat,join,split), instance Text String
   6
   7 import iTasks
   8 import mTask
   9
  10 derive class iTask MTaskMessage
  11
  12 Start :: *World -> *World
  13 Start world = startEngine (withShared ([], False, [], False) mTaskTask) world
  14 //Start world = startEngine mTaskTask world
  15
  16 mTaskTask :: (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task ()
  17 mTaskTask ch =
  18         syncNetworkChannel "localhost" 8124 "\n" decode encode ch ||-
  19         (
  20                 sendMsg (hd msgs) ch >>= \_->
  21                 sendMsg (hd (tl msgs)) ch >>= \_->
  22                 viewSharedInformation "channels" [ViewWith lens] ch @! ()
  23         )
  24         where
  25                 lens :: ([MTaskMessage],Bool,[MTaskMessage],Bool) -> ([String], [String])
  26                 lens (r,_,s,_) = (map toString r, map toString s)
  27
  28                 msgs = toMessages 500 (toRealByteCode (unMain bc))
  29
  30                 bc :: Main (ByteCode Int Expr)
  31                 bc = sds \x=0 In {main = x =. x +. lit 1}
  32
  33 makemTask :: Int (Main (ByteCode a Expr)) -> String
  34 makemTask to bc
  35 # (bc, st) = toRealByteCode (unMain bc)
  36 = "t" +++ toString (toChar (to / 265))
  37         +++ toString (toChar (to rem 265)) +++ toString bc +++ "\n"
  38
  39 sendMsg :: MTaskMessage (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task ()
  40 sendMsg m ch
  41 | not (trace_tn ("\'" +++ toString m +++ "\'")) = undef
  42 = upd (\(r,rs,s,ss)->(r,rs,s ++ [m],ss)) ch @! ()
  43
  44 syncNetworkChannel :: String Int String (String -> m) (m -> String) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
  45 syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
  46         = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
  47         where
  48                 onConnect _ (received,receiveStopped,send,sendStopped)
  49                         = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False)
  50                 whileConnected Nothing acc (received,receiveStopped,send,sendStopped)
  51                         = (Ok acc, Nothing, [], False)
  52                 whileConnected (Just newData) acc (received,receiveStopped,send,sendStopped)
  53                 # [acc:msgs] = reverse (split msgSeparator (concat [acc,newData]))
  54                 # write = if (not (isEmpty msgs && isEmpty send))
  55                         (Just (received ++ map decodeFun (reverse msgs),receiveStopped,[],sendStopped))
  56                         Nothing
  57                 = (Ok acc,write,map encodeFun send,False)
  58
  59                 onDisconnect l (received,receiveStopped,send,sendStopped)
  60                         = (Ok l,Just (received,True,send,sendStopped))
  61
  62 consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
  63 consumeNetworkStream processTask channel
  64         = ((watch channel >>* [OnValue (ifValue ifProcess process)]) <! id) @! ()
  65         where
  66                 ifProcess (received,receiveStopped,_,_)
  67                         = receiveStopped || (not (isEmpty received))
  68
  69                 process (received,receiveStopped,_,_)
  70                         =   upd empty channel
  71                         >>| if (isEmpty received) (return ()) (processTask received)
  72                         @!  receiveStopped
  73
  74                 empty :: ([m],Bool,[m],Bool) -> ([m],Bool,[m],Bool)
  75                 empty (_,rs,s,ss) = ([],rs,s,ss)