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 Start :: *World -> *World
  11 Start world = startEngine (withShared ([], False, [], False) mTaskTask) world
  12 //Start world = startEngine mTaskTask world
  13
  14 mTaskTask :: (Shared ([String],Bool,[String],Bool)) -> Task ()
  15 mTaskTask ch =
  16         syncNetworkChannel "localhost" 8124 "\n" id id ch ||-
  17         viewSharedInformation "channels" [ViewWith lens] ch ||-
  18         sendString (makemTask 500 bc) ch @! ()
  19         where
  20                 lens :: ([String],Bool,[String],Bool) -> String
  21                 lens (r,_,s,_) = "channels"
  22
  23                 bc :: Main (ByteCode Int Expr)
  24                 bc = sds \x=0 In {main = x =. x +. lit 1}
  25
  26 makemTask :: Int (Main (ByteCode a Expr)) -> String
  27 makemTask to bc
  28 # (bc, st) = toRealByteCode (unMain bc)
  29 = "t" +++ toString (toChar (to / 265))
  30         +++ toString (toChar (to rem 265)) +++ toString bc +++ "\n"
  31
  32 sendString :: String (Shared ([String],Bool,[String],Bool)) -> Task ()
  33 sendString m ch = upd (\(r,rs,s,ss)->(r,rs,s ++ [m],ss)) ch @! ()
  34
  35 syncNetworkChannel :: String Int String (String -> m) (m -> String) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
  36 syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
  37         = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
  38         where
  39                 onConnect _ (received,receiveStopped,send,sendStopped)
  40                         = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False)
  41                 whileConnected Nothing acc (received,receiveStopped,send,sendStopped)
  42                         = (Ok acc, Nothing, [], False)
  43                 whileConnected (Just newData) acc (received,receiveStopped,send,sendStopped)
  44                 # [acc:msgs] = reverse (split msgSeparator (concat [acc,newData]))
  45                 # write = if (not (isEmpty msgs && isEmpty send))
  46                         (Just (received ++ map decodeFun (reverse msgs),receiveStopped,[],sendStopped))
  47                         Nothing
  48                 = (Ok acc,write,map encodeFun send,False)
  49
  50                 onDisconnect l (received,receiveStopped,send,sendStopped)
  51                         = (Ok l,Just (received,True,send,sendStopped))
  52
  53 consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
  54 consumeNetworkStream processTask channel
  55         = ((watch channel >>* [OnValue (ifValue ifProcess process)]) <! id) @! ()
  56         where
  57                 ifProcess (received,receiveStopped,_,_)
  58                         = receiveStopped || (not (isEmpty received))
  59
  60                 process (received,receiveStopped,_,_)
  61                         =   upd empty channel
  62                         >>| if (isEmpty received) (return ()) (processTask received)
  63                         @!  receiveStopped
  64
  65                 empty :: ([m],Bool,[m],Bool) -> ([m],Bool,[m],Bool)
  66                 empty (_,rs,s,ss) = ([],rs,s,ss)