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 qualified Data.Map as DM

from Data.Func import $
import Data.Tuple
import Data.List
import System.Directory

import iTasks._Framework.Store

import TTY, iTasksTTY

derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED

:: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)

:: SerTCP = SerialDevice | TCPDevice
:: MTaskDevice = {
		deviceTask :: Maybe TaskId,
		deviceConnected :: Maybe String,
		deviceName :: String,
		deviceTasks :: [(String, Int)]
	}
:: MTaskShare = {
		initValue :: Int,
		withTask :: String,
		identifier :: Int,
		realShare :: String
	}

Start :: *World -> *World
Start world = startEngine (mTaskManager
	>>* [OnAction (Action "Shutdown") (always $ shutDown)]) world

memoryShare :: String a -> Shared a | iTask a
memoryShare s d = sdsFocus s $ memoryStore "" $ Just d

deviceStore :: Shared [MTaskDevice]
deviceStore = memoryShare "mTaskDevices" []

sdsStore :: Shared [MTaskShare]
sdsStore = memoryShare "mTaskShares" []

bcStateStore :: Shared BCState
bcStateStore = memoryShare "mTaskBCState" zero

mTaskTaskStore :: Shared [String]
mTaskTaskStore = memoryShare "mTaskTasks" ["ledder", "ledon", "ledoff"]

mTaskMap :: Map String (Main (ByteCode () Stmt))
mTaskMap = 'DM'.fromList [("ledder", bc), ("ledon", bc2 LED1), ("ledoff", bc3 LED3)]

bc :: Main (ByteCode () Stmt)
bc = sds \x=1 In sds \pinnetje=1 In {main =
		IF (digitalRead D3) (
			x =. x +. lit 1 :.
			pub x
		) (
			noOp
		) :.
		IF (pinnetje ==. lit 1) (
			ledOn LED1
		) (
			IF (pinnetje ==. lit 2) (
				ledOn LED2
			) (
				ledOn LED3
			)
		)}

bc2 :: UserLED -> Main (ByteCode () Stmt)
bc2 d = {main = ledOn d}

bc3 :: UserLED -> Main (ByteCode () Stmt)
bc3 d = {main = ledOff d}

:: MTaskDeviceStatus = {connected :: Bool, name :: String, tasks :: [(String, Int)]}
derive class iTask MTaskDeviceStatus, MTaskDevice, MTaskShare, BCState

mTaskManager :: Task ()
mTaskManager = anyTask 
		[ viewmTasks @! ()
		, viewShares
		, whileUnchanged deviceStore viewDevices
		] <<@ ApplyLayout layout
	where
		layout = sequenceLayouts
			[ arrangeWithSideBar 0 LeftSide 260 True
			, arrangeSplit Vertical True
			]

		viewmTasks = listmTasks
			>&^ \sh->whileUnchanged sh $ \mi->case mi of
				Nothing = viewInformation "No task selected" [] ()
				Just mTaskTask = get deviceStore
					>>= \devices->case devices of
						[] = viewInformation "No devices yet" [] ()
						ds = sendmTask mTaskTask ds @! ()
			where
				listmTasks :: Task String
				listmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore

				sendmTask mTaskId ds = 
						(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
						-&&- enterInformation "Timeout, 0 for one-shot" [])
					>>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskId)]

				sendToDevice :: String (MTaskDevice, Int) -> Task ()
				sendToDevice mTask (device, timeout) =
						get bcStateStore @ createBytecode
					>>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
					>>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare
					>>| makeShares sdss
					>>| upd (\(r,s,ss)->(r,s++msgs,ss)) (channels device)
					@! ()
					where
						createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) st
						sharename i = fromJust (device.deviceConnected) +++ "-" +++ toString i
						toSDSRecords st = [{MTaskShare |
							initValue=toInt d1*265 + toInt d2,
							withTask=mTask,
							identifier=i,
							realShare="mTaskSDS-" +++ toString i}
								\\(i,[d1,d2])<-st.sdss]
						makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())

		getSDSStore :: MTaskShare -> Shared Int
		getSDSStore sh = memoryShare sh.realShare 0

		getSDSRecord :: Int -> Task MTaskShare
		getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i]

		channels :: MTaskDevice -> Shared Channels
		channels d = memoryShare (fromJust d.deviceConnected) ([], [], False)

		viewShares :: Task ()
		viewShares = whileUnchanged sdsStore $ anyTask o map viewer
			where
				viewer :: MTaskShare -> Task ()
				viewer m = viewSharedInformation "" [] (getSDSStore m)
					<<@ Title ("SDS: " +++ toString m.identifier) @! ()
//				enterChoiceWithShared "Shares" [ChooseFromList id] sdsStore
//			>>* [OnValue $ withValue $ Just o updateShare]
//			>>* [OnAction (Action "Back") (const $ Just $ treturn ())]
//			where
//				sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v]
//				updateShare s = viewInformation "" [] ()
//				updateShare (k, v) = (viewInformation "Key" [] k
//					||- updateInformation "Value" [] v)
					

		viewDevices :: [MTaskDevice] -> Task ()
		viewDevices ds = anyTask [
				addDevice deviceStore <<@ Title "Add new device" @! ():
					[viewDevice d <<@ Title d.deviceName\\d<-ds]]
			<<@ ArrangeWithTabs @! ()
		
		viewDevice :: MTaskDevice -> Task ()
		viewDevice d = (viewInformation "Device settings" [] d 
				||- (case d.deviceConnected of
					Just s = viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
					Nothing = viewInformation "No channels yet" [] "" @! ()
				)) <<@ ArrangeHorizontal
			where
				dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)

		addDevice :: (Shared [MTaskDevice]) -> Task SerTCP
		addDevice devices = enterInformation "Device type" []
			>&^ \sh->whileUnchanged sh $ \mty->case mty of
				Nothing = viewInformation "No type selected yet" [] "" @! ()
				Just ty = case ty of
					TCPDevice = (enterInformation "Name" [] -&&- enterInformation "Hostname" [] -&&- enterInformation "Port" [])
						>>= \(name, (host, port))->cont name (syncNetworkChannel host port)
					SerialDevice = accWorld getTTYDevices
						>>= \dl->(enterInformation "Name" [] -&&- enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
						>>= \(name, (dev, set))->cont name (syncSerialChannel dev set encode decode)
			where
				cont :: String ((Shared Channels) -> Task ()) -> Task ()
				cont name synfun = get randomInt 
					@ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[], deviceTask=Nothing})
					>>= \dev->appendTopLevelTask 'DM'.newMap True (let ch = channels dev in process ch -||- synfun ch)
					>>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
					@! ()

		process :: (Shared Channels) -> Task ()
		process ch = forever (watch ch >>* [OnValue (
				ifValue (not o isEmpty o fst3)
				(\t->upd (appFst3 (const [])) ch >>| process (fst3 t)))])
 			where
				process :: [MTaskMSGRecv] -> Task ()
 				process [] = treturn ()
				process [m:ms] = (case m of
					MTTaskAck i = traceValue (toString m) @! ()
					MTTaskDelAck i = traceValue (toString m) @! ()
					MTSDSAck i = traceValue (toString m) @! ()
					MTSDSDelAck i = traceValue (toString m) @! ()
					MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
					MTMessage val = traceValue (toString m) @! ()
					MTEmpty = traceValue (toString m) @! ()
					) >>| process ms


		deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus]
		deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName,
			connected = if (isNothing d.deviceConnected) False True,
			tasks = d.deviceTasks}\\d<-ds]

		mapPar :: (a -> Task a) [a] -> Task ()
		mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
		allAtOnce t = foldr1 (||-) t @! ()
		//allAtOnce = (flip (@!) ()) o foldr1 (||-)

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

syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()
syncNetworkChannel server port channel = catchAll
		(tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ())
		(\v->traceValue v @! ())
	where
		onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
		onConnect _ (msgs,send,sendStopped)
			= (Ok "", Just (msgs,[],sendStopped), map encode send, False)

		whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
		whileConnected Nothing acc (msgs,send,sendStopped)
		= (Ok acc, Nothing, [], False)

		whileConnected (Just newData) acc (msgs,send,sendStopped)
		= (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
		//| sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
//		= (Ok acc, Just (msgs ++ [decode newData],[],False), [], False)
		
		onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
		onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)