started with itasks integration
authorMart Lubbers <mart@martlubbers.net>
Wed, 21 Dec 2016 19:06:46 +0000 (20:06 +0100)
committerMart Lubbers <mart@martlubbers.net>
Wed, 21 Dec 2016 19:06:46 +0000 (20:06 +0100)
.gitignore
Makefile
mTaskInterpret.icl
miTask.icl [new file with mode: 0644]

index 9505dbe..ea93a2b 100644 (file)
@@ -5,3 +5,5 @@ sapl
 mTask-data
 mTaskInterpret
 mTaskMakeSymbols
+miTask-data
+miTask
index 1a36a32..da62a3c 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -23,7 +23,7 @@ CLMLIBS:=\
        -I $(CLEAN_HOME)/lib/TCPIP\
        -I ./CleanSerial
 
-BINARIES:= mTaskExamples mTaskInterpret
+BINARIES:= mTaskExamples mTaskInterpret miTask
 
 all: $(BINARIES) int/mTaskSymbols.h
 
@@ -33,5 +33,6 @@ int/mTaskSymbols.h: mTaskMakeSymbols
 %: %.icl $(wildcard *.[id]cl)
        $(CLM) $(CLMLIBS) $(CLMFLAGS) $(basename $<) -o $@
 
+
 clean:
        $(RM) -r $(BINARIES) Clean\ System\ Files
index 81bf135..789c58a 100644 (file)
@@ -161,8 +161,8 @@ toReadableByteCode x
 //             bc = (lit 36 +. lit 42) +. lit 44
 
 Start :: String
-//Start = toReadableByteCode $ unMain bc
-Start = toRealByteCode $ unMain bc
+Start = toReadableByteCode $ unMain bc
+//Start = toRealByteCode $ unMain bc
        where
                bc :: Main (ByteCode Int Expr)
                bc = sds \x=41 In 
diff --git a/miTask.icl b/miTask.icl
new file mode 100644 (file)
index 0000000..84b2563
--- /dev/null
@@ -0,0 +1,49 @@
+module miTask
+
+import StdDebug, StdMisc
+
+from Text import class Text(concat,join,split), instance Text String
+
+import iTasks
+import mTask
+
+Start :: *World -> *World
+Start world = startEngine mTaskTask world
+
+mTaskTask :: Task ()
+mTaskTask = withShared ([],False,[],False) (\ch->
+               syncNetworkChannel "localhost" 8123 "\n" id id ch ||- 
+               updateSharedInformation "channels" [] ch @! ())
+
+syncNetworkChannel :: String Int String (String -> m) (m -> String) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
+syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
+       = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
+       where
+               onConnect _ (received,receiveStopped,send,sendStopped)
+                       = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False)
+               whileConnected Nothing acc (received,receiveStopped,send,sendStopped)
+                       = (Ok acc, Nothing, [], False)
+               whileConnected (Just newData) acc (received,receiveStopped,send,sendStopped)
+               # [acc:msgs] = reverse (split msgSeparator (concat [acc,newData]))
+               # write = if (not (isEmpty msgs && isEmpty send))
+                       (Just (received ++ map decodeFun (reverse msgs),receiveStopped,[],sendStopped))
+                       Nothing
+               = (Ok acc,write,map encodeFun send,False)
+               
+               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)