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 (
  14         enterInformation "Port Number?" []
  15         >>= \port->withShared ([], False, [], False) (mTaskTask port)
  16         ) world
  17 Start world = startEngine mTaskTask world
  18
  19 mTaskTask :: Int (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task ()
  20 mTaskTask port ch =
  21         syncNetworkChannel "localhost" port "\n" decode encode ch ||-
  22         (
  23                 sendMsg msgs ch >>= \_->
  24                 viewSharedInformation "channels" [ViewWith lens] ch @! ()
  25         ) >>* [OnAction ActionFinish (always shutDown)]
  26         where
  27                 lens :: ([MTaskMessage],Bool,[MTaskMessage],Bool) -> ([String], [String])
  28                 lens (r,_,s,_) = (f r, f s)
  29                         where
  30                                 f [] = []
  31                                 f [MTEmpty:xs] = f xs
  32                                 f [x:xs] = [toString x:f xs]
  33
  34                 msgs
  35                 | not (trace_tn (fst (toReadableByteCode (unMain bc)))) = undef
  36                 = toMessages 500 (toRealByteCode (unMain bc))
  37
  38                 bc :: Main (ByteCode Int Stmt)
  39                 bc = sds \x=1 In {main =
  40                         If (x ==. lit 3)
  41                         (x =. lit 1)
  42                         (x =. x +. lit 1) :. pub x}
  43
  44 sendMsg :: [MTaskMessage] (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task ()
  45 sendMsg m ch
  46 | not (trace_tn (join "\n" (map (toString o toJSON) m))) = undef
  47 = upd (\(r,rs,s,ss)->(r,rs,s ++ m,ss)) ch @! ()
  48
  49 syncNetworkChannel :: String Int String (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
  50 syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
  51         = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
  52         where
  53                 onConnect _ (received,receiveStopped,send,sendStopped)
  54                         = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False)
  55                 whileConnected Nothing acc (received,receiveStopped,send,sendStopped)
  56                         = (Ok acc, Nothing, [], False)
  57                 whileConnected (Just newData) acc (received,receiveStopped,send,sendStopped)
  58                 # [acc:msgs] = reverse (split msgSeparator (concat [acc,newData]))
  59                 # write = if (not (isEmpty msgs && isEmpty send))
  60                         (Just (received ++ map decodeFun (reverse msgs),receiveStopped,[],sendStopped))
  61                         Nothing
  62                 = (Ok acc,write,map encodeFun send,False)
  63
  64                 onDisconnect l (received,receiveStopped,send,sendStopped)
  65                         = (Ok l,Just (received,True,send,sendStopped))
  66
  67 //consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
  68 //consumeNetworkStream processTask channel
  69 //      = ((watch channel >>* [OnValue (ifValue ifProcess process)]) <! id) @! ()
  70 //      where
  71 //              ifProcess (received,receiveStopped,_,_)
  72 //                      = receiveStopped || (not (isEmpty received))
  73 //
  74 //              process (received,receiveStopped,_,_)
  75 //                      =   upd empty channel
  76 //                      >>| if (isEmpty received) (return ()) (processTask received)
  77 //                      @!  receiveStopped
  78 //
  79 //              empty :: ([m],Bool,[m],Bool) -> ([m],Bool,[m],Bool)
  80 //              empty (_,rs,s,ss) = ([],rs,s,ss)