From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 21 Dec 2016 19:06:46 +0000 (+0100)
Subject: started with itasks integration
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;ds=sidebyside;h=c667554eb5dc359481a5f84b60649169f31e0f3d;p=mTask.git

started with itasks integration
---

diff --git a/.gitignore b/.gitignore
index 9505dbe..ea93a2b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,3 +5,5 @@ sapl
 mTask-data
 mTaskInterpret
 mTaskMakeSymbols
+miTask-data
+miTask
diff --git a/Makefile b/Makefile
index 1a36a32..da62a3c 100644
--- 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
diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 81bf135..789c58a 100644
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -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
index 0000000..84b2563
--- /dev/null
+++ b/miTask.icl
@@ -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)