module miTask

import StdDebug, StdMisc
from StdFunc import flip

import iTasks
import mTask

from Text import class Text(startsWith,concat,split,join), instance Text String

import Data.Tuple
import System.Directory

import iTasks.UI.Definition

import iTasks._Framework.TaskState
import iTasks._Framework.TaskServer
import iTasks._Framework.IWorld
import iTasks._Framework.Store

import TTY

derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize
derive class iTask MTaskMSGRecv, MTaskMSGSend

:: *Resource | TTYd !*TTY

Start :: *World -> *World
Start world = startEngine (withShared ([], False, [], False) mTaskTask) world
//Start world = startEngine mTaskTask world
//
deviceSelectorNetwork :: Task (Int, String)
deviceSelectorNetwork = enterInformation "Port Number?" []
	-&&- enterInformation "Network address" []

deviceSelectorSerial :: Task (String, TTYSettings)
deviceSelectorSerial = accWorld getDevices
	>>= \dl->(enterChoice "Device" [] dl -&&- deviceSettings)
	where
		deviceSettings = updateInformation "Settings" [] zero

		getDevices :: !*World -> *(![String], !*World)
		getDevices w = case readDirectory "/dev" w of
			(Error (errcode, errmsg), w) = abort errmsg
			(Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w)
			where
				isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
				prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]

derive class iTask SerTCP
:: SerTCP = Serial | TCP

mTaskTask :: (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
mTaskTask ch =
	(enterInformation "Choose" [] >>= \st->case st of
		Serial = deviceSelectorSerial >>= \(s,set)->syncSerialChannel s set decode encode ch
		TCP = deviceSelectorNetwork >>= \(p,h)->syncNetworkChannel h p "\n" decode encode ch
		) ||-
	sendMsg msgs ch ||-
	(
		(
			consumeNetworkStream (processSDSs sdsShares messageShare) ch ||-
			viewSharedInformation "channels" [ViewWith lens] ch ||-
			viewSh sdsShares ch
		) >>* [OnAction ActionFinish (always shutDown)]
	)
	where
		messageShare :: Shared [String]
		messageShare = sharedStore "mTaskMessagesRecv" []

		processSDSs :: [(Int, Shared Int)] (Shared [String]) [MTaskMSGRecv] -> Task ()
		processSDSs _ _ [] = return ()
		processSDSs s y [x:xs] = updateSDSs s y x >>= \_->processSDSs s y xs

		updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task ()
		updateSDSs _ m (MTMessage s) = upd (\l->take 20 [s:l]) m @! ()
		updateSDSs _ _ MTEmpty = return ()
		updateSDSs [(id, sh):xs] m n=:(MTPub i d)
		| id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
		= updateSDSs xs m n

		lens :: ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool) -> ([String], [String])
		lens (r,_,s,_) = (f r, map toString s)
			where
				f [] = []
				f [MTEmpty:xs] = f xs
				f [x:xs] = [toString x:f xs]

		viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
		viewSh [] ch = return ()
		viewSh [(i, sh):xs] ch
		# sharename = "SDS-" +++ toString i
		= (
				viewSharedInformation ("SDS-" +++ toString i) [] sh ||-
				forever (
					enterInformation sharename []
					>>* [OnAction ActionOk 
							(ifValue (\j->j>=1 && j <= 3) 
							(\c->set c sh
								>>= \_->sendMsg (toSDSUpdate i c) ch
								@! ()
							)
						)]
				)
			) ||- viewSh xs ch

		sdsShares = makeShares st

		(msgs, st) = toMessages 500 (toRealByteCode (unMain bc))

		bc :: Main (ByteCode () Stmt)
		bc = sds \x=1 In sds \pinnetje=1 In {main =
				IF (digitalRead D3 ==. lit True) (
					x =. x +. lit 1 :.
					pub x
				) (
					noOp
				) :.
				IF (pinnetje ==. lit 1) (
					digitalWrite D0 (lit True) :.
					digitalWrite D1 (lit False) :.
					digitalWrite D2 (lit False)
				) (
					IF (pinnetje ==. lit 2) (
						digitalWrite D0 (lit False) :.
						digitalWrite D1 (lit True) :.
						digitalWrite D2 (lit False)
					) (
						digitalWrite D0 (lit False) :.
						digitalWrite D1 (lit False) :.
						digitalWrite D2 (lit True)
					)
				)}
//		bc :: Main (ByteCode Int Stmt)
//		bc = sds \x=1 In {main =
//			If (x ==. lit 3)
//			(x =. lit 1)
//			(x =. x +. lit 1) :. pub x}

makeShares :: BCState -> [(Int, Shared Int)]
makeShares {sdss=[]} = []
makeShares s=:{sdss=[(i,d):xs]} =
	[(i, ms ("mTaskSDS-" +++ toString i) 1):makeShares {s & sdss=xs}]
	where
		ms name i = sdsFocus name (memoryStore name (Just i))

sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
sendMsg m ch = upd (\(r,rs,s,ss)->(r,rs,s ++ m,ss)) ch @! ()

syncSerialChannel :: String TTYSettings (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
syncSerialChannel dev opts decodeFun encodeFun rw = Task eval
	where
		eval event evalOpts tree=:(TCInit taskId ts) iworld=:{IWorld|world}
		= case TTYopen dev opts world of
			(False, _, world)
			# (err, world) = TTYerror world
			= (ExceptionResult (exception err), {iworld & world=world})
			(True, tty, world)
			# iworld = {iworld & world=world, resources=Just (TTYd tty)}
			= case addBackgroundTask 42 (BackgroundTask (serialDeviceBackgroundTask rw decodeFun encodeFun)) iworld of
				(Error e, iworld) = (ExceptionResult (exception "h"), iworld)
				(Ok _, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} NoRep (TCBasic taskId ts JSONNull False), iworld)

		eval _ _ tree=:(TCBasic _ ts _ _) iworld
		= (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} NoRep tree, iworld)

		eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
		# (TTYd tty) = fromJust resources
		# (ok, world) = TTYclose tty world
		# iworld = {iworld & world=world,resources=Nothing}
		= case removeBackgroundTask  42 iworld of
			(Error e, iworld) = (ExceptionResult (exception "h"), iworld)
			(Ok _, iworld) = (DestroyedResult, iworld)

serialDeviceBackgroundTask :: (Shared ([m],Bool,[n],Bool)) (String -> m) (n -> String) !*IWorld -> *IWorld
serialDeviceBackgroundTask rw de en iworld
	= case read rw iworld of
		(Error e, iworld) = abort "share couldn't be read"
		(Ok (r,rs,s,ss), iworld)
		# (Just (TTYd tty)) = iworld.resources
		# tty = writet (map en s) tty
		# (ml, tty) = case TTYavailable tty of
			(False, tty) = ([], tty)
			(_, tty)
			# (l, tty) = TTYreadline tty
			= ([de l], tty)
		# iworld = {iworld & resources=Just (TTYd tty)}
		= case write (r++ml,rs,[],ss) rw iworld of
			(Error e, iworld) = abort "share couldn't be written"
			(Ok _, iworld) = case notify rw iworld of
				(Error e, iworld) = abort "share couldn't be notified"
				(Ok _, iworld) = iworld
	where
		writet :: [String] !*TTY -> *TTY
		writet [] t = t
		writet [x:xs] t = writet xs (TTYwrite x t)


syncNetworkChannel :: String Int String (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
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,[n],Bool)) -> Task () | iTask m & iTask n
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,[n],Bool) -> ([m],Bool,[n],Bool)
		empty (_,rs,s,ss) = ([],rs,s,ss)